Ｐａｇｅ 159 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼Array以外の方法を教えてください。 デヤン 02/10/2(水) 10:25 ┗Re:Array以外の方法を教えてください。 Nakamura 02/10/2(水) 12:58 ┗Re:Array以外の方法を教えてください。 デヤン 02/10/2(水) 14:11 ┗Re:Array以外の方法を教えてください。 Hirofumi 02/10/2(水) 20:26 ┗Re:Array以外の方法を教えてください。 Hirofumi 02/10/2(水) 21:11 ┗Re:Array以外の方法を教えてください。 デヤン 02/10/3(木) 10:06 ┗Re:Array以外の方法を教えてください。 Hirofumi 02/10/3(木) 19:36 ─────────────────────────────────────── ■題名 ： Array以外の方法を教えてください。 ■名前 ： デヤン ■日付 ： 02/10/2(水) 10:25 -------------------------------------------------------------------------
| 初めまして、ＶＢＡ初心者の者です。 特に難しくもない質問かもしれませんが教えてください。 コマンドボタンを押すと、テキストファイルを読み込み 列Ａ〜ＡＴまでテキストファイルのデータを分ける。 このような処理をしたいのです。 解かりにくいと思うので例えを用いて説明すると。 例え テキストファイルに以下のデータが入っているとします。 テキストファイルのデータ：１２３４５６・・・ＸＹＺ ・ ・ ・ コマンドボタンを押し、テキストファイルを読み込むと ＿｜Ａ｜Ｂ｜ Ｃ｜ Ｄ｜・・・・｜ＡＲ｜ＡＳ｜ＡＴ｜←列 １｜１｜２｜３４｜５６｜・・・・｜Ｘ ｜Ｙ ｜Ｚ ｜ ２｜ ｜ ｜ ｜ ｜・・・・｜ ｜ ｜ ｜ ↑ ・ 行 ・ ・ この様にしたいのです。 Arrayを使い自力でやってはみたのですがArrayは 項目数の制限があるらしく「コンパイルエラー、 メモリーが不足しています。」となってしまいます。 ＶＢＡ初心者なので他の方法がわかりません。 Arrayを使わずにできる方法がありましたら 教えてください。お願いします。 ちなみにＥｘｃｅｌ９７を使用しています。 |
| ▼デヤン さん： こんにちは >例え >テキストファイルに以下のデータが入っているとします。 > >テキストファイルのデータ：１２３４５６・・・ＸＹＺ > ・ > ・ > ・ > >コマンドボタンを押し、テキストファイルを読み込むと > >＿｜Ａ｜Ｂ｜ Ｃ｜ Ｄ｜・・・・｜ＡＲ｜ＡＳ｜ＡＴ｜←列 >１｜１｜２｜３４｜５６｜・・・・｜Ｘ ｜Ｙ ｜Ｚ ｜ >２｜ ｜ ｜ ｜ ｜・・・・｜ ｜ ｜ ｜ >↑ ・ >行 ・ > ・ > >この様にしたいのです。 これだけでは、レスの付けようがないです。 セルに振り分ける法則性も解りませんし・・ もう少し、詳しく書いた上で、デヤン さんの考えた コードもアップすればレスが付き易い思います。 >テキストファイルのデータ：１２３４５６・・・ＸＹＺ これが、スペースもカンマもない連続した文字列？なら これを 文字列形式の変数に格納して、Right、Left、Midなどの文字列操作関数を 使って、セルに振り分けるというのはどうでしょう？ それでは |
| ▼Nakamura さん： >▼デヤン さん： > >こんにちは nakamuraさん、こんにちわ。 >これだけでは、レスの付けようがないです。 >セルに振り分ける法則性も解りませんし・・ >もう少し、詳しく書いた上で、デヤン さんの考えた >コードもアップすればレスが付き易い思います。 > すいません。簡単に書きすぎました。 コードは以下の通りです。ただ、文字列を振り分けてるだけの ものですが・・・。 Private Sub CommandButton1_Click() Workbooks.OpenText FileName:="C:\WINDOWS\ﾃﾞｽｸﾄｯﾌﾟ\VBA\test.txt", _ StartRow :=11, DataType:=xlFixedWidth, FieldInfo:= _ Array(Array(0, 2), Array(1, 1), Array(2, 1), Array(11, 1), _ Array(12, 1), Array(33, 1), Array(34, 1), Array(36, 1), _ Array(37, 1), Array(39, 1), Array(40, 1), Array(42, 1), _ Array(43, 1), Array(45, 1), Array(46, 1), Array(48, 1), _ Array(49, 1), Array(51, 1), Array(52, 1), Array(54, 1), _ Array(55, 1), Array(57, 1), Array(58, 1), Array(60, 1), _ Array(61, 1), Array(63, 1), Array(64, 1), Array(66, 1), _ Array(67, 1), Array(69, 1), Array(70, 1), Array(72, 1), _ Array(73, 1), Array(75, 1), Array(76, 1), Array(78, 1), _ Array(79, 1), Array(81, 1), Array(82, 1), Array(84, 1), _ Array(85, 1), Array(87, 1), Array(88, 1), Array(90, 1), _ Array(91, 1), Array(93, 1), Array(94, 1), Array(96, 1), _ Array(97, 1), Array(99, 1), Array(100, 1), Array(102, 1), _ Array(103, 1), Array(105, 1), Array(106, 1), Array(108, 1), _ Array(109, 1), Array(111, 1), Array(112, 1), Array(114, 1), _ Array(115, 1), Array(117, 1), Array(118, 1), Array(120, 1), _ Array(121, 1), Array(123, 1), Array(124, 1), Array(126, 1), _ Array(127, 1), Array(129, 1), Array(130, 1), Array(132, 1)) End Sub >>テキストファイルのデータ：１２３４５６・・・ＸＹＺ > >これが、スペースもカンマもない連続した文字列？なら >これを 文字列形式の変数に格納して、Right、Left、Midなどの文字列操作関数を >使って、セルに振り分けるというのはどうでしょう？ > >それでは そうです。スペースもカンマもない文字列です。 文字列操作関数ですか。具体的にどのように書けばいいのですか？ 初心者丸だしですいません。 |
| 横から失礼しますが 以前に作った物が使えそうなので少し長くなりますがUpします Openステートメントを使った読み込みです TextファイルのCｒLfまでを一行として読み込みます また、フィールド長の設定は、 "設定"と言うシートを作成し、そのセルに、列見出し、 フィールド長、セル書式を記入します その方法は、 "設定"シートのB1からC1、D1・・に、列見出しを記入 （記入しなければ、表示されないだけ） B2からC2、D2、・・と、フィールドの長さをバイト単位（全角２バイト、半角１バイト） の整数で記入 B3、C3、D3・・と読み込むセルの書式を記入 （""が何もしない、1が標準、2が文字列、3がyyyy/mm/ddの日付） 数値を文字列として読み込むような場合以外は設定しない方が早いと思います Sub CommandButton1でコメントアウトの様にすれば、A1からデータを書き込むと思います Private Sub CommandButton1_Click() Dim intCalc As Integer Dim sinTime1 As Single Dim sinTime2 As Single sinTime1 = Timer With Application '画面更新を停止 .ScreenUpdating = False '再計算の方法を保存 intCalc = .Calculation '再計算を手動へ .Calculation = xlCalculationManual End With SDFReadTextADV "C:\WINDOWS\ﾃﾞｽｸﾄｯﾌﾟ\VBA\test.txt", 2 'SDFReadTextADV "C:\WINDOWS\ﾃﾞｽｸﾄｯﾌﾟ\VBA\test.txt", 1 With Application '再計算の仕方を元に戻す .Calculation = intCalc '再計算を実行 .Calculate '画面更新を再開 .ScreenUpdating = True End With sinTime2 = Timer Worksheets("設定").Range("D20").Value = sinTime2 - sinTime1 Cells.EntireColumn.AutoFit Cells(1, 1).Select Beep MsgBox "処理が終了しました", vbOKOnly, "終了" End Sub 以下を同じ標準モジュールへ記入 Option Explicit Public Sub SDFReadText(strFileName As String, _ Optional lngListRow As Long = 2) Dim i As Long Dim dfn As Integer Dim vntField As Variant Dim intFieldMax As Integer Dim strLine As String Dim vntDatas As Variant Dim lngRecLeng As Long Dim lngLineMax As Long '設定シートからフィールド長等を読み込み、列見出しを書き込む GetFieldAttribute vntField intFieldMax = UBound(vntField, 2) If lngListRow > 1 Then PutFieldNames lngListRow - 1, lngListRow - 1 End If For i = 1 To intFieldMax lngRecLeng = lngRecLeng + CLng(vntField(1, i)) Next i lngRecLeng = lngRecLeng + 2 lngLineMax = FileLen(strFileName) \ lngRecLeng For i = 1 To intFieldMax CellsForm Range(Cells(lngListRow, i), Cells(lngListRow + lngLineMax, i)), vntField(2, i) Next i dfn = FreeFile Open strFileName For Input As dfn ReDim vntDatas(1 To 1, 1 To intFieldMax) Do Until EOF(dfn) Line Input #dfn, strLine vntDatas = DivideStr(strLine, vntField) Range(Cells(lngListRow, 1), _ Cells(lngListRow, intFieldMax)).Value = vntDatas 'シートの書き込み行を１つ更新 lngListRow = lngListRow + 1 Loop 'ファイルを閉じる Close dfn End Sub Private Function DivideStr(ByVal strLine As String, _ vntLength As Variant) As Variant Dim i As Long Dim lngPos As Long Dim vntData As Variant Dim intDataMax As Integer 'Unicodeからシステムの既定のコード ページに変換します strLine = StrConv(strLine, vbFromUnicode) lngPos = 1 intDataMax = UBound(vntLength, 2) ReDim vntData(1 To 1, 1 To intDataMax) For i = 1 To intDataMax vntData(1, i) = Trim(StrConv(MidB(strLine, lngPos, CLng(vntLength(1, i))), vbUnicode)) lngPos = lngPos + CLng(vntLength(1, i)) Next i DivideStr = vntData End Function Private Sub GetFieldAttribute(vntField As Variant) ' 設定Field長、変換方法の読み込み Dim lngColEnd As Long With ThisWorkbook.Worksheets("設定") lngColEnd = .Cells(2, 256).End(xlToLeft).Column vntField = .Range(.Cells(2, 2), .Cells(3, lngColEnd)).Value End With End Sub Private Sub CellsForm(rngLocate As Range, vntFormNo As Variant) ' セルの設定（必要な場合、Dataの加工） With rngLocate Select Case vntFormNo Case 1 .NumberFormatLocal = "G/標準" Case 2 .NumberFormatLocal = "@" Case 3 .NumberFormatLocal = "yyyy/mm/dd" End Select End With End Sub Private Sub PutFieldNames(lngRow As Long, lngCol As Long) ' 列見出しの書きこみ Dim lngColEnd As Long Dim vntTmp As Variant With ThisWorkbook.Worksheets("設定") lngColEnd = .Cells(1, 256).End(xlToLeft).Column vntTmp = .Range(.Cells(1, 2), .Cells(1, lngColEnd)).Value End With With Range(Cells(lngRow, lngCol), Cells(lngRow, lngColEnd - 1)) .Value = vntTmp .Interior.ColorIndex = 34 End With End Sub |
| あ！書き忘れました このコードは、アクティブシートにデータを書き込んで行きます "設定"シートや他のシートがアクティブに成っている時に実行すると、 書き換えてしまうので気をつけて下さい OpenTextの様に新しいBookに書きこまれる訳では有りません また、読み込む速度は速い方では有りません、というより遅い方です "設定"シートの書き方はこんな感じ A B C D E 1 旧番号 新番号 府県名 町村名 2 Field長 6 6 8 30 3 書式 2 2 |
| Hirofumiさん、おはようございます。 おかげさまで、なんとかできるように なりました。ありがとうございます。 |
| コードに間違えが有りました Sub SDFReadTextの以下の部分を修正してください 現状 If lngListRow > 1 Then PutFieldNames lngListRow - 1, lngListRow - 1 End If 修正 If lngListRow > 1 Then PutFieldNames lngListRow - 1, 1 End If |