Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

305 / 76735

←次へ　｜　前へ→


	【82098】Re:２つのシートのデータをまとめる作業

マナ - 22/11/16(水) 20:39 -


	引用なし

	パスワード

▼ace さん：

Sub test()
　　Dim dic As Object
　　Dim 見出Sht As Worksheet, 詳細Sht As Worksheet
　　Dim r As Range, w() As String, v
　　Dim k As Long
　　Dim No As String, idx As Long, s1 As String, s2 As String
　
　　Set dic = CreateObject("scripting.dictionary")
　　Set 見出Sht = Worksheets("見出")
　　Set 詳細Sht = Worksheets("詳細")
　
　　Set r = 見出Sht.Columns("D").SpecialCells(xlCellTypeConstants).Resize(, 3)
　　ReDim w(1 To r.Rows.Count, 1 To 3)
　　v = r.Value
　　For k = 1 To UBound(v)
　　　　No = v(k, 1) & "_" & v(k, 2) & "_" & v(k, 3)　　 '証区分_年度_No,
　　　　idx = k
　　　　If Not dic.exists(No) Then dic(No) = idx
　　Next
　
　　Set r = 詳細Sht.Columns("D").SpecialCells(xlCellTypeConstants).Resize(, 11)
　　With r.Offset(, 9999)　　'右側の空き領域を作業セルとして使用
　　　　.Value = r.Value
　　　　.Sort .Columns(4)
　　　　v = .Value
　　　　.Clear
　　End With

　
　　For k = 1 To UBound(v)
　　　　No = v(k, 1) & "_" & v(k, 2) & "_" & v(k, 3)　　 '証区分_年度_No,
　　　　If dic.exists(No) Then
　　　　　　idx = dic(No)
　　　　　　s1 = v(k, 10)　　'項目
　　　　　　s2 = v(k, 11)　 '結果
　　　　　　s2 = s1 & "(" & s2 & ")"
　　　　　　w(idx, 1) = IIf(w(idx, 1) = "", s1, w(idx, 1) & "," & s1)
　　　　　　w(idx, 2) = IIf(w(idx, 2) = "", s2, w(idx, 2) & "," & s2)
　　　　End If
　　Next

　　Set r = 見出Sht.Columns("AA:AB")
　　r.ClearContents
　　r.Resize(UBound(w)).Value = w
　　r.AutoFit
　　
　　Set r = 見出Sht.Columns("A")
　　r.Resize(UBound(w)).Formula = "=text(h1,""yy/mm"")&p1"
　
End Sub

16 hits

▼

【82088】２つのシートのデータをまとめる作業 ace 22/11/7(月) 13:40