Excel VBA質問箱 IV

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

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


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

385 / 76807

←次へ　｜　前へ→


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

マナ - 22/11/8(火) 18:55 -


	引用なし

	パスワード

▼ace さん：
>
Option Explicit

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("E").SpecialCells(xlCellTypeConstants).Resize(, 2)
　　ReDim w(1 To r.Rows.Count, 1 To 2)
　　v = r.Value
　　For k = 1 To UBound(v)
　　　　No = v(k, 1) & "_" & v(k, 2)　　'年度_No,
　　　　idx = k
　　　　If Not dic.exists(No) Then dic(No) = idx
　　Next
　　
　　Set r = 詳細Sht.Columns("E").SpecialCells(xlCellTypeConstants).Resize(, 10)
　　v = r.Value
　　v = WorksheetFunction.Sort(v, 3, 1, False)　'G列(SEQ)でソート
　　
　　For k = 1 To UBound(v)
　　　　No = v(k, 1) & "_" & v(k, 2)　　'年度_No,
　　　　If dic.exists(No) Then
　　　　　　idx = dic(No)
　　　　　　s1 = v(k, 9)　　'項目
　　　　　　s2 = v(k, 10)　 '結果
　　　　　　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
　　
End Sub

1 hits

▼

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