| |
▼こんばんは さん：
おはようございます。
何となくわかってきました。
>
>A sheet
>> 列Ａ B：F
>>1NO（文字列）情報
>>2DTQA654FR AのNoに対しての情報行
>>3bb bb情報
>>4ccc ccc情報
>>5bbb bbb情報
>
>B sheet
>> 列Ａ B：F
>>1NO（文字列）情報
>>2DTQA654FR AのNoに対しての情報行
>>3bbb bbb情報
>>4cc cc情報
>>5bbb bbb情報
>
>C sheet
>> 列Ａ B：F
>>1NO（文字列）情報
>>2DTQA654FR AのNoに対しての情報行
>>3bbb bbb情報
>>4ccc ccc情報
>>5bb bb情報
↑この情報を有した入力データとしての
ブックをBook1.xlsとします。
コードをどこに記述するのかが明確になっていませんが、
上記のブックにしましょう。
まず、標準モジュールに
'==================================================
Sub main()
Dim idx As Long
Dim ans As Collection
Dim sht As Worksheet
Set ans = no_dup(Workbooks("book1.xls")) 'この引数に検査するブックを指定
Set sht = Workbooks.Add.Worksheets(1)
sht.Range("a1:h1") = Array("ＮＯ", "inf1", "inf2", "inf3", "inf4", "inf5", "", "シート名")
For idx = 1 To ans.Count
With ans.Item(idx)
sht.Range(sht.Cells(idx + 1, 1), sht.Cells(idx + 1, 6)).Value = .infarray
If .scnt < ThisWorkbook.Sheets.Count Then
sht.Cells(idx + 1, 8).Value = .shtnm
End If
End With
Next
End Sub
'===================================================================
Function no_dup(bk As Workbook) As Collection
Dim i_data As Class1
Dim idx As Long
Dim rng As Range
Dim crng As Range
Dim shnm As String
Dim sdx As Long
On Error Resume Next
Set no_dup = New Collection
For idx = 1 To bk.Sheets.Count
With bk.Sheets(idx)
sdx = idx
Set rng = .Range("a2", .Cells(.Rows.Count, 1).End(xlUp))
If rng.Row > 1 Then
shnm = .Name
For Each crng In rng
Set i_data = New Class1
With i_data
.infarray = crng.Resize(1, 6).Value
.shtnm = shnm
.scnt = 1
.last_index = idx
End With
no_dup.Add i_data, crng.Value
If Err.Number <> 0 Then
With no_dup.Item(crng.Value)
If .last_index <> idx Then
.shtnm = .shtnm & "&" & shnm
.scnt = .scnt + 1
.last_index = idx
End If
End With
End If
Next
End If
End With
Next
End Function
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
クラスモジュールに（クラス名は class1）
'===========================================
Public infarray As Variant
Public shtnm As String
Public scnt As Long
Public last_index As Long
これでmainを実行してみて下さい。
新規ブックに
>
> 検証結果（新bookにて）
>> 列Ａ B：F H
>>1NO（見出し）
>>2DTQA654FR 情報行 （全sheetにある為sheet名は出さない）
>>3bbb 情報1 〃
>>4ccc 情報2 A&C
>>5bb 情報3 A&C
>>6cc 情報2 （B)
>
と言う結果が作成されます（順序は違いますが）
確認してみて下さい。
|
|
ichinose
- 06/1/24(火) 8:05 -
