Excel VBA質問箱 IV

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

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


13881 / 76734 ←次へ | 前へ→

【68355】Re:セルを比べて同じなら・・・
発言  kanabun  - 11/2/25(金) 17:06 -

引用なし
パスワード
   ▼ののか さん:
おじゃまします。

すべて配列にコピーして 配列内で統合してみたらどうですか?

6列目をキーにしています。

Sub 統合プログラム()

 Dim BOOKNAME     '元ファイル名
 Dim WS1 As Worksheet '対象シート
 Dim Target As Range   '処理対象範囲
 Dim i As Long, j As Long, n As Long, m As Long
 Dim v As Variant
 Dim key
 
 'ファイルを開く
  BOOKNAME = Application.GetOpenFilename(MultiSelect:=False)
  If VarType(BOOKNAME) = vbBoolean Then Exit Sub
  
  With Workbooks.Open(Filename:=BOOKNAME)
    BOOKNAME = .Name
    Set WS1 = .Worksheets(Left$(BOOKNAME, Len(BOOKNAME) - 4)) '対象シート
  End With
  Set Target = WS1.Range("A1").CurrentRegion
  v = Target.Value
  m = UBound(v, 2)
  n = 1
  For i = 2 To UBound(v)
   If key <> v(i, 6) Then
     key = v(i, 6)
     n = n + 1
     If n <> i Then
       For j = 1 To m
         v(n, j) = v(i, j)
       Next
     End If
   Else
     For j = 15 To 20
       v(n, j) = v(n, j) + v(i, j)
     Next
   End If
  Next
  Target.ClearContents
  Target.Resize(n).Value = v
End Sub
0 hits

【68352】セルを比べて同じなら・・・ ののか 11/2/25(金) 15:54 質問
【68353】Re:セルを比べて同じなら・・・ Jaka 11/2/25(金) 16:36 発言
【68354】Re:セルを比べて同じなら・・・ ののか 11/2/25(金) 16:50 お礼
【68356】Re:セルを比べて同じなら・・・ Jaka 11/2/25(金) 17:16 発言
【68358】Re:セルを比べて同じなら・・・ ののか 11/2/25(金) 17:24 お礼
【68359】Re:セルを比べて同じなら・・・ SK63 11/2/25(金) 17:52 発言
【68355】Re:セルを比べて同じなら・・・ kanabun 11/2/25(金) 17:06 発言
【68357】Re:セルを比べて同じなら・・・ ののか 11/2/25(金) 17:23 お礼

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