Excel VBA質問箱 IV

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

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


9117 / 13646 ツリー ←次へ | 前へ→

【29134】CSVのデータを加算していく方法について ピンキー 05/9/26(月) 14:28 質問[未読]
【29141】Re:CSVのデータを加算していく方法について Jaka 05/9/26(月) 17:11 回答[未読]
【29148】Re:CSVのデータを加算していく方法について ピンキー 05/9/26(月) 17:38 発言[未読]
【29157】Re:CSVのデータを加算していく方法について Hirofumi 05/9/26(月) 21:22 回答[未読]
【29160】Re:CSVのデータを加算していく方法について だるま 05/9/26(月) 22:37 回答[未読]
【29230】Re:CSVのデータを加算していく方法について ピンキー 05/9/28(水) 15:03 発言[未読]
【29243】Re:CSVのデータを加算していく方法について だるま 05/9/28(水) 19:39 回答[未読]
【29278】Re:CSVのデータを加算していく方法について ピンキー 05/9/29(木) 14:30 お礼[未読]

【29134】CSVのデータを加算していく方法について
質問  ピンキー  - 05/9/26(月) 14:28 -

引用なし
パスワード
   こんにちわ。
CSVで保存してあるデータからエクセルのファイルにデータを書き加えていきたいのですが方法を教えて下さい。
*エクセルファイル
 1    2    3
 店   りんご  みかん
A店    0     1
B店    1     1
C店    1     2
D店    1     0
 :    :     :
*CSVファイル
 1    2    3
 店   りんご  みかん
A店    2     1
C店    1     0
D店    1     1
処理後は
 1    2    3
 店   りんご  みかん
A店    2     2
B店    1     1
C店    2     2
D店    2     1
 :    :     :
という風にしたいのですが、CSVにあるデータから店の名前を参照してエクセルのファイルに数字を加えていくというやり方がわかりません。よろしければ教えていただけないでしょうか?
よろしくお願いします。

【29141】Re:CSVのデータを加算していく方法につい...
回答  Jaka  - 05/9/26(月) 17:11 -

引用なし
パスワード
   CSVファイルをエクセルで普通に開いて、新規ブックにデータを統合し、そのブックをCSV保存するのが簡単かと思います。
手作業で出来ますから、マクロ記録でもされたらどうでしょうか?

因みにこれは.....??
[#26610]

【29148】Re:CSVのデータを加算していく方法につい...
発言  ピンキー  - 05/9/26(月) 17:38 -

引用なし
パスワード
   ▼Jaka さん:
こんいちわ。Jakaさん書き込みありがとうございます。
>CSVファイルをエクセルで普通に開いて、新規ブックにデータを統合し、そのブックをCSV保存するのが簡単かと思います。
>手作業で出来ますから、マクロ記録でもされたらどうでしょうか?
統合という機能はまだ使った事がないので試してみます。
>因みにこれは.....??
>[#26610]
すいません。解決していたのですが、放置状態になっていました。以後気をつけていきますので、本当にすみませんでしたm(__)m

【29157】Re:CSVのデータを加算していく方法につい...
回答  Hirofumi  - 05/9/26(月) 21:22 -

引用なし
パスワード
   一応コンなので加算出きると思います

エクセルBookは、

  A    B    C
1  店   りんご  みかん
2 A店    0     1
3 B店    1     1
4 C店    1     2
5 D店    1     0

で、店名は、昇順に並べられて居る物とします

Csvファイルは、

店,りんご,みかん
A店 , 2, 1
C店 , 1, 0
D店 , 1, 1

の形で、列見だしが(Headerが)有る物とします

Option Explicit

Public Sub CrossTabulation()

  '果物名の有る列数
  Const clngColumns As Long = 2
  
  Dim i As Long
  Dim strPath As String
  Dim dfn As Integer
  Dim vntFileName As Variant
  Dim strBuff As String
  Dim vntField As Variant
  Dim vntData As Variant
  Dim lngRow As Long
  Dim rngStores As Range
  Dim rngResult As Range
  Dim blnHeader As Boolean
  Dim strProm As String
  
  'Textファイルの有るフォルダを指定
'  strPath = "E:\Office2000\Excel\Test5\A"

  '読み込むファイルを取得(ダイアログ表示し、其処から選択)
  If Not GetReadFile(vntFileName, strPath, False) Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If

  Application.ScreenUpdating = False

  'ActiveSheetのA1セルを基準とする(Listの左上隅)
  Set rngResult = ActiveSheet.Cells(1, "A")
  With rngResult
    '店名が有る行数を取得
    lngRow = .Offset(65536 - .Row).End(xlUp).Row - .Row
    '店名が有る範囲を取得
    If lngRow > 0 Then
      Set rngStores = .Offset(1).Resize(lngRow)
    End If
  End With

  '指定されたファイルをOpen
  dfn = FreeFile
  Open vntFileName For Input As dfn
  
  'ヘッダFlagをTrueに(ヘッダ行、1行読み飛ばす場合)
  'ヘッダ行が無いならここをFalseにする
  blnHeader = True
  'ファイルから日付を取得
  Do Until EOF(dfn)
    'ファイルから1行読み込み
    Line Input #dfn, strBuff
    'ヘッダ行、1行読み飛ばし
    If Not blnHeader Then
      'フィールドに分割
      vntField = Split(strBuff, ",", , vbBinaryCompare)
      '店名を探索(店名が無ければ、行挿入を行い店名を記述
      lngRow = GetStoresRow(vntField(0), rngStores, rngResult)
      '店名の有る行に加算
      With rngResult
        '果物範囲のデータを配列に取得
        vntData = .Offset(lngRow, 1).Resize(, clngColumns).Value
        'Csvの値を加算
        For i = 1 To clngColumns
          vntData(1, i) = vntData(1, i) + Val(vntField(i))
        Next i
        '果物範囲に配列うぃ出力
        .Offset(lngRow, 1).Resize(, clngColumns).Value = vntData
      End With
    Else
      'ヘッダFlagをFalseに
      blnHeader = False
    End If
  Loop
  
  Close #dfn

  strProm = "処理が完了しました"
  
Wayout:

  Application.ScreenUpdating = True

  Set rngStores = Nothing
  Set rngResult = Nothing

  Beep
  MsgBox strProm

End Sub

Private Function GetStoresRow(vntTagNo As Variant, _
            rngScope As Range, _
            rngListTop As Range) As Long

  Dim lngFound As Long
  Dim lngOver As Long
  Dim lngCount As Long

  '店名範囲に店名が無いなら
  If rngScope Is Nothing Then
    lngFound = 0
    lngCount = 0
    lngOver = 1
  Else
    '店名を探索
    lngFound = DataSearch(vntTagNo, rngScope, lngOver)
    lngCount = rngScope.Rows.Count
  End If

  '探索成功(店名が有るなら)
  If lngFound > 0 Then
    '位置を返す
    GetStoresRow = lngFound
  Else
    With rngListTop
      '挿入位置が行末で無いなら
      If lngOver <= lngCount Then
        '行を挿入
        .Offset(lngOver).EntireRow.Insert
      End If
      'セルの書式を文字列に設定
'      .Offset(lngOver).NumberFormatLocal = "@"
      '店名を書き込み
      .Offset(lngOver).Value = vntTagNo
      '挿入位置を返す
      GetStoresRow = lngOver
      '探索範囲の更新
      Set rngScope _
        = .Offset(1).Resize(lngCount + 1)
    End With
  End If

End Function

Private Function DataSearch(vntKey As Variant, _
            rngScope As Range, _
            Optional lngOver As Long, _
            Optional lngMode As Long = 1) As Long

  Dim vntFind As Variant

  'Matchによる二分探索
  vntFind = Application.Match(vntKey, rngScope, lngMode)
  lngOver = 1
  'もし、エラーで無いなら
  If Not IsError(vntFind) Then
    'もし、Key値と探索位置の値が等しいなら
    If vntKey = rngScope(vntFind).Value Then
      '戻り値として、行位置を代入
      DataSearch = vntFind
    End If
    'Key値を超える最小値のある行
    lngOver = vntFind + 1
  End If

End Function

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, 1, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【29160】Re:CSVのデータを加算していく方法につい...
回答  だるま WEB  - 05/9/26(月) 22:37 -

引用なし
パスワード
   こんにちは

私もひとつ作ってみましたのでよろしければどうぞ。^d^

Sub AddFromCSV()
  Dim Dic As Object
  Dim myRange As Range
  Dim myCell As Range
  Dim myPath As String
  Dim N As Integer
  Dim K As String
  Dim Item1 As Integer, Item2 As Integer
  
  Set Dic = CreateObject("Scripting.Dictionary")
  
  '処理対象セル範囲
  Set myRange = ActiveSheet.UsedRange
  
  For Each myCell In myRange.Columns(1).Cells
    Set Dic.Item(myCell.Value) = myCell
  Next
  
  '読み込むCSVファイル
  myPath = ThisWorkbook.Path & "\test.csv"
  N = FreeFile
  
  Open myPath For Input As #N
  Line Input #N, K  'タイトル読み飛ばし
  
  Do Until EOF(N)
    Input #N, K, Item1, Item2
    If Dic.Exists(K) Then
      Set myCell = Dic.Item(K)
    Else
      Set myCell = myRange.Cells(1, 1).End(xlDown).Offset(1)
      myCell.Value = K
      Set Dic.Item(K) = myCell
    End If
    
    With myCell
      .Offset(, 1).Value = .Offset(, 1).Value + Item1
      .Offset(, 2).Value = .Offset(, 2).Value + Item2
    End With
  Loop
  Close #N
  
  Set myCell = Nothing
  Set myRange = Nothing
  Set Dic = Nothing
End Sub

【29230】Re:CSVのデータを加算していく方法につい...
発言  ピンキー  - 05/9/28(水) 15:03 -

引用なし
パスワード
   Jakaさん、Hirofumiさん、だるまさん、こんにちわ。
お返事が遅くなってすみません。
今回はだるまさんのコードを使わせて頂きました。
みなさん本当にありがとうございました。
質問ばかりですみませんが、取り込む列が2列増えてしまったので
>.Offset(, 2).Value = .Offset(, 2).Value + Item2

.Offset(, 4).Value = .Offset(, 4).Value + Item2
にしてみたのですが、2列飛ばしになってしまいました。
すべて取り込むにはどうしたらよいのでしょうか?
よろしくおねがいします。

【29243】Re:CSVのデータを加算していく方法につい...
回答  だるま WEB  - 05/9/28(水) 19:39 -

引用なし
パスワード
   >Dim Item1 As Integer, Item2 As Integer
Dim Item1 As Integer, Item2 As Integer
Dim Item3 As Integer, Item4 As Integer

>      .Offset(, 1).Value = .Offset(, 1).Value + Item1
>      .Offset(, 2).Value = .Offset(, 2).Value + Item2
      .Offset(, 1).Value = .Offset(, 1).Value + Item1
      .Offset(, 2).Value = .Offset(, 2).Value + Item2
      .Offset(, 3).Value = .Offset(, 3).Value + Item3
      .Offset(, 4).Value = .Offset(, 4).Value + Item4

とりあえずこんな感じでしょうか。

配列を使った方がスッキリしますが、まあもっと増えたときには検討してください。^d^

【29278】Re:CSVのデータを加算していく方法につい...
お礼  ピンキー  - 05/9/29(木) 14:30 -

引用なし
パスワード
   だるまさん。こんにちわ。
バッチリでした!!
ここまでお付き合い頂き本当にありがとうございました。
Jakaさん、Hirofumiさんもありがとうございました。
今後ともよろしくお願いします。

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