Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9789 / 13645 ツリー ←次へ | 前へ→

【25287】値・文字データがランダムに入ったテキストファイル抽出について おソラ 05/5/26(木) 15:58 質問[未読]
【25295】Re:値・文字データがランダムに入ったテ... 小僧 05/5/27(金) 10:00 回答[未読]
【25374】小僧さん・「Unicode」の指定方法について おソラ 05/5/30(月) 10:24 質問[未読]
【25384】Re:小僧さん・「Unicode」の指定方法につ... 小僧 05/5/30(月) 11:37 発言[未読]
【25420】Re:小僧さん・「Unicode」の指定方法につ... おソラ 05/5/31(火) 13:15 質問[未読]
【25422】Re:小僧さん・「Unicode」の指定方法につ... 小僧 05/5/31(火) 14:05 発言[未読]
【25425】小僧さん・「Unicode」の指定方法につ... おソラ 05/5/31(火) 15:05 発言[未読]
【25421】Re:値・文字データがランダムに入ったテキ... おさる 05/5/31(火) 13:32 発言[未読]
【25424】おさるさん おソラ 05/5/31(火) 14:33 発言[未読]
【25433】Re:値・文字データがランダムに入ったテキ... Hirofumi 05/5/31(火) 20:57 回答[未読]
【25436】プロシージャ1つ書き忘れました Hirofumi 05/5/31(火) 22:15 回答[未読]
【25450】Hirofumi さん おソラ 05/6/1(水) 10:01 お礼[未読]
【25451】Re:Hirofumi さん m2m10 05/6/1(水) 10:07 回答[未読]
【25456】Hirofumi さん m2m10さん 集計の件 おソラ 05/6/1(水) 11:52 発言[未読]
【25457】Re:Hirofumi さん m2m10さん 集計の件 Jaka 05/6/1(水) 13:06 発言[未読]
【25471】Jaka さん おソラ 05/6/1(水) 17:04 お礼[未読]

【25287】値・文字データがランダムに入ったテキス...
質問  おソラ  - 05/5/26(木) 15:58 -

引用なし
パスワード
   こんにちは。超初心者ですがご相談に乗っていただけると嬉しいです。
【目的】
数字・文字が羅列されたテキストファイルより
データを抽出しエクセルの列にうめていきたい

テキストファイル例:※(文字)以外全て半角数字になります。
.TextFileFixedColumnWidths =
Array(10, 15, 5, 8, 3, 5, 10(文字), 5, 10(文字), 2, 6, 6, 6, 6)
【現在の状況】
10桁分の文字が文字は全角・・空白は半角
文字数は行によってデータがすべて異なります。
抜粋例:
1行目・〜19712江戸川区・・・・・・98763〜
2行目・〜19876西区・・・・・・・・09876〜
※恐らくこの条件が災いを招き文字が始まる列から
完全に文字化けしてしまう状況です。

【現在のコード】
Range("A1:N1").Select
  With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .MergeCells = False
  End With
  Selection.Font.Bold = True
  Range("A2").Select
  With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Documents and Settings\Owner\My Documents\でーたもと.txt", Destination _
    :=Range("A2"))
    .Name = "でーたもと."
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = 1
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 1)

'ここで2文字列指定をしているので文字化けする理由がわからないのです。

    .TextFileFixedColumnWidths = Array(10, 15, 5, 8, 3, 5, 10, 5, 10, 2, 6, 6, 6, 6)

'ケタ数を其々指定して列に割り振るコードのつもりです。

    .Refresh BackgroundQuery:=False
  End With
  Cells.Select
  With Selection.Font
    .Name = "MS Pゴシック"
    .Size = 9
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
  End With
  Range("A1").Select
  Columns("A:A").EntireColumn.AutoFit
  Columns("B:B").EntireColumn.AutoFit
  Columns("C:C").EntireColumn.AutoFit
  Columns("D:D").EntireColumn.AutoFit
  Columns("E:E").EntireColumn.AutoFit
  Columns("F:F").EntireColumn.AutoFit
  Columns("G:G").EntireColumn.AutoFit
  Columns("H:H").EntireColumn.AutoFit
  Columns("I:I").EntireColumn.AutoFit
  Columns("J:J").ColumnWidth = 9.5
  Columns("J:J").EntireColumn.AutoFit
  Columns("K:K").EntireColumn.AutoFit
  Columns("L:L").EntireColumn.AutoFit
  Columns("M:M").EntireColumn.AutoFit
  Columns("N:N").EntireColumn.AutoFit
  'Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess,
    'OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    ':=xlPinYin
  'Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(10), _
    'Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

'ここで4列目でグループを組んで10列目の数字の
合計を計算させたいと考えております。

/////////////////////////////////////////////////////////////
まったくの初心者なので、
ExcelパーフェクトマスターVBAという本を購入してみましたが、
今回の現象についてコードをうまくなおせませんでした。
どんな事でも結構ですのでご指摘ご相談・ご教授頂けたらとおもいます。

【25295】Re:値・文字データがランダムに入ったテ...
回答  小僧  - 05/5/27(金) 10:00 -

引用なし
パスワード
   ▼おソラ さん:
こんにちは。

テキストの漢字コードを「Unicode」に指定してすると
文字化けなしでインポートできる模様です。

【25374】小僧さん・「Unicode」の指定方法について
質問  おソラ  - 05/5/30(月) 10:24 -

引用なし
パスワード
   小僧さん
コメントありがとう御座います

テキストの漢字コードを「Unicode」に指定すると
文字化けなしでインポートできるとご指摘を受けましたが
具体的にはどのように指定するコードを記述すれば
いいのか・・・わかりません。
初心者なため恐縮では御座いますが、
もしよかったら教えてください。

【25384】Re:小僧さん・「Unicode」の指定方法につ...
発言  小僧  - 05/5/30(月) 11:37 -

引用なし
パスワード
   ▼おソラ さん:
こんにちは。

当方もおソラさんのコードを再現すると文字化けが発生してしまったため、
元のテキストファイルをUnicodeで保存したら問題なく動いた、という次第です。

メモ帳にはそういった機能がないのでフリーソフトですと

http://www.vector.co.jp/soft/win95/writing/se104390.html

にある「TeraPad」というソフトで変換できました。

VBAで元ファイルをUnicodeにする方法ですが…

元ファイルをバイナリで読み込み Put で書き込めば良い

とWeb検索で出てきましたが、実際のコードまでは当方では解りかねます。
すみません。

【25420】Re:小僧さん・「Unicode」の指定方法につ...
質問  おソラ  - 05/5/31(火) 13:15 -

引用なし
パスワード
   小僧 さん

すみません。。。
教えていただいた「TeraPad」を利用して
Unicodeに保存しなおしVBを実行したのですが、
今度はタイトル行以外全て文字化けになってしまいました。
私の操作方法が悪かったのでしょうか・・・

【25421】Re:値・文字データがランダムに入ったテ...
発言  おさる  - 05/5/31(火) 13:32 -

引用なし
パスワード
   マルチポストはやめましょうね。

【25422】Re:小僧さん・「Unicode」の指定方法につ...
発言  小僧  - 05/5/31(火) 14:05 -

引用なし
パスワード
   ▼おソラ さん:
こんにちは。
当方の環境で

1234567890123451234567890123451234567812312345あいうえお12345かきくけこ12123456123456123456123456
1111111111222222222222222333334444444455500000666666666677777888888888899000000111111222222333333

という仮データをおソラさんのコードで(変えたのはファイルパスだけです。)
インポートした結果、「あいうえお」「6666666666」「かきくけこ」「8888888888」
という文字型でシートに記述されました。
「S-JIS」や「JIS」ですと文字化けするのですが「Unicode」だと化けませんね。
(Windows XP , Excel2002 SP3)

>※マルチポスト(複数の掲示板にまったく同じ話題を投稿すること)だそうですが、
>こちらの掲示板では容認されてますが、他の掲示板には禁止となっている所も
>もちろんあります。気をつけましょう。

【25424】おさるさん
発言  おソラ  - 05/5/31(火) 14:33 -

引用なし
パスワード
    おさる さん

ご忠告ありがとう御座います。

大変困っていたので
全く別のエクセルVBA掲示板にも
1箇所だけ書き込んでしまいました。

双方見ているユーザが違うので様々な意見を
いただけるかとおもったのと

今回マルチポストという言葉を始めて知り
何故マルチポストが嫌がられるか?という理由:
投稿がほったらかしになる

ということは考えられないため 
悪気なく書き込んでしまいました。


【25425】小僧さん・「Unicode」の指定方法につ...
発言  おソラ  - 05/5/31(火) 15:05 -

引用なし
パスワード
   小僧 さん

私のデータは漢字交じり+桁数がランダムだからなのでしょうか。。。
もうちょっと自分でもやってみます。

-------
それにしても『おさるさん』という方に
マルチポストの指摘を書き込んだ2箇所の掲示板に其々
同じように”注意”をされました。
小僧さんが気分悪くしたらと懸念していたので
コメント頂けてよかったです。ありがとう御座います。
 

【25433】Re:値・文字データがランダムに入ったテ...
回答  Hirofumi  - 05/5/31(火) 20:57 -

引用なし
パスワード
   ま、半分冗談の積もりで作って見ました
条件は、
Array(10, 15, 5, 8, 3, 5, 10(文字), 5, 10(文字), 2, 6, 6, 6, 6)
の中で、2ヶ所「10(文字)」の位置が、不定数の全角文字と半角スペースで構成され
その他のフィールドは、半角数字で構成されたTextで
1行づつ改行されている物と考えます
上手く行かなかったらゴメン

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRow As Long
  Dim dfn As Integer
  Dim vntFileName As Variant
  Dim strBuff As String
  Dim vntField As Variant
  Dim rngResult As Range
  Dim strDataPath As String
  
  'データの有るPathを指定
'  strDataPath = "C:\Documents and Settings\Owner\My Documents"

  'ファイル名を指定(拡張子は無し、ここを指定しなければ、
  '指定された拡張子の全てのファイル名表示)
'  vntFileName = "でーたもと"

  'ファイルを開くダイアログ表示
  If Not GetReadFile(vntFileName, strDataPath) Then
    Exit Sub
  End If

  '結果を書き込むシートの先頭セル位置を指定
  Set rngResult = ActiveSheet.Cells(1, "A")
  
  'ファイルをInputモードでOpen
  dfn = FreeFile
  Open vntFileName For Input As dfn
  
  'ファイルEndまで繰り返し
  Do Until EOF(dfn)
    '1行変数に読み込み
    Line Input #dfn, strBuff
    '1行をフィールドに分割
    vntField = DataSplit(strBuff)
    '指定したシートの指定したセルに就いて
    With rngResult.Offset(lngRow)
      '先頭2セルの書式を文字列に指定
      .Resize(, 2).NumberFormatLocal = "@"
      '指定したシートにデータを書き込み
      .Resize(, UBound(vntField) + 1).Value = vntField
    End With
    '書き込み行を更新
    lngRow = lngRow + 1
  Loop
  
  'ファイルをClose
  Close #dfn
    
  Set rngResult = Nothing
  
  Beep
  MsgBox "処理が完了しました"
  
End Sub

Private Function DataSplit(strMark As String) As Variant

  Dim i As Long
  Dim lngPos As Long
  Dim vntSplit As Variant
  Dim vntField As Variant
  Dim strLetter As String
  
  'フィールド長を指定(-1の場合、半角数字が出るまで文字を連結)
  vntSplit = Array(10, 15, 5, 8, 3, 5, -1, 5, -1, 2, 6, 6, 6, 6)
  '結果用配列を確保
  ReDim vntField(UBound(vntSplit))
  
  '読み込み位置の初期値設定
  lngPos = 1
  'フィールド数分繰り返し
  For i = 0 To UBound(vntSplit)
    'もし、フィールド長が-1で無ければ
    If vntSplit(i) <> -1 Then
      '読み込み位置から、指定フィールド長分文字を切り出して
      '結果用配列に格納
      vntField(i) = Mid(strMark, lngPos, vntSplit(i))
      '読み込み位置を更新
      lngPos = lngPos + vntSplit(i)
    Else
      '-1の場合、半角数字が出るまで文字を連結
      strLetter = Mid(strMark, lngPos, 1)
      Do Until 48 <= Asc(strLetter) And Asc(strLetter) <= 57
        vntField(i) = vntField(i) + strLetter
        lngPos = lngPos + 1
        strLetter = Mid(strMark, lngPos, 1)
      Loop
    End If
  Next i

  '戻り値として、結果用配列を返す
  DataSplit = vntField
  
End Function

【25436】プロシージャ1つ書き忘れました
回答  Hirofumi  - 05/5/31(火) 22:15 -

引用なし
パスワード
   ゴメン
以下のプロシージャを、入れ忘れました
此れを同じ標準モジュールに入れて下さい
入れないと動きません

Private Function GetReadFile(vntFileNames As Variant, _
            Optional strFilePath As String, _
            Optional blnMultiSel As Boolean _
                    = False) As Boolean

  Dim strFilter As String
  
  'フィルタ文字列を作成
  strFilter = "CSV File (*.csv),*.csv," _
        & "Text File (*.txt),*.txt," _
        & "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
        & "全て (*.*),*.*"
  '読み込むファイルの有るフォルダを指定
  If strFilePath <> "" Then
    'ファイルを開くダイアログ表示ホルダに移動
    ChDrive Left(strFilePath, 1)
    ChDir strFilePath
  End If
  'もし、ディフォルトのファイル名が有る場合
  If vntFileNames <> "" Then
    SendKeys vntFileNames & "{TAB}", False
  End If
  '「ファイルを開く」ダイアログを表示
  vntFileNames _
      = Application.GetOpenFilename(strFilter, 2, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【25450】Hirofumi さん
お礼  おソラ  - 05/6/1(水) 10:01 -

引用なし
パスワード
   Hirofumi さん

でっできました!!!!!!!!
こんにちは。始めまして。
とても丁寧にコード書いていただいてありがとう御座いました。
表示されました。今の気持ちはなんだか興奮しすぎて!!

コードの意味解読に勉強不足というか
これから少しずつ勉強していこうとおもいます。
本当にありがとう御座いました。ひとまず落ち着きました。

そして、、実に加えてお恥ずかしながら、、
このVBにB列(種別情報がはいっています)
をグループにしてK列(料金情報が入っています)を
集計したいのですが、何かよいコードはありますか。

※現在は手作業でデータ⇒集計 で行っています。

今後とも何卒よろしく御願いします。

【25451】Re:Hirofumi さん
回答  m2m10  - 05/6/1(水) 10:07 -

引用なし
パスワード
   ピポットテーブルが簡単です。

【25456】Hirofumi さん m2m10さん 集計の件
発言  おソラ  - 05/6/1(水) 11:52 -

引用なし
パスワード
   Hirofumi さん
の教えていただいたコード
  Beep
  MsgBox "処理が完了しました"
の下に以下を追加してみました。
        
  Range("A1").Select
  Columns("A:A").EntireColumn.AutoFit
  Columns("B:B").EntireColumn.AutoFit
  Columns("C:C").EntireColumn.AutoFit
  Columns("D:D").EntireColumn.AutoFit
  Columns("E:E").EntireColumn.AutoFit
  Columns("F:F").EntireColumn.AutoFit
  Columns("G:G").EntireColumn.AutoFit
  Columns("H:H").EntireColumn.AutoFit
  Columns("I:I").EntireColumn.AutoFit
  Columns("J:J").EntireColumn.AutoFit
  Columns("J:J").EntireColumn.AutoFit
  Columns("K:K").EntireColumn.AutoFit
  Columns("L:L").EntireColumn.AutoFit
  Columns("M:M").EntireColumn.AutoFit
  Columns("N:N").EntireColumn.AutoFit
   
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(12), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

---------------------------------------------
合ってるかな・・・
とりあえず”集計”うまくいったみたいです(涙)
ありがとう御座います。

【25457】Re:Hirofumi さん m2m10さん 集計の件
発言  Jaka  - 05/6/1(水) 13:06 -

引用なし
パスワード
   こんにちは。
        
>  'Range("A1").Select
>  Columns("A:A").EntireColumn.AutoFit
    ・
    ・
>  Columns("N:N").EntireColumn.AutoFit
    ↓
   Columns(1).Resize(, 14).EntireColumn.AutoFit

 ↓Subtotalの事はわからないけど、上でA1を選択する必要もなく直接指定できます。
Range("A1").Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(12), _
>Replace:=True, PageBreaks:=False, SummaryBelowData:=True

【25471】Jaka さん
お礼  おソラ  - 05/6/1(水) 17:04 -

引用なし
パスワード
   Jaka さん

こんにちは。大変勉強になります。
早速コード直してやってみました。
できました し すっきりしました。
ありがとう御座いました

9789 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free