| |
こんな感じでどうでしょーか ?
ちょっとややこしいコードになりますが、テストは成功しています。
Sub LGV_Address()
Dim Cc As Long, i As Long, j As Long
Dim ErW As Long, Cnt As Long
Dim Ad As String
Dim MyV As Variant
Dim MyR As Range, C As Range, FR As Range
Set MyR = Worksheets("Sheet1").Range("A1").CurrentRegion
Cc = MyR.Columns.Count: Ad = MyR.Address
For i = 1 To MyR.Rows.Count
If i = 1 Then
j = 1
Else
j = j + Cc
End If
MyV = WorksheetFunction.Transpose(MyR.Rows(i).Value)
Sheets("Sheet2").Cells(j, 1).Resize(Cc).Value = MyV
Next i
With Sheets("Sheet2")
ErW = .Range("A65536").End(xlUp).Row
With .Range("A1:A" & ErW)
.Sort Key1:=.Cells(1), Order1:=xlDescending, _
Header:=xlNo, Orientation:=xlSortColumns
.Offset(, 255).Formula = "=COUNTIF(Sheet1!" & Ad & ",$A1)"
End With
i = 1: j = 0
Do
Cnt = .Cells(i, 256).Value
For j = 1 To Cnt
If j = 1 Then
Set FR = _
MyR.Find(.Cells(i, 1).Value, , xlValues, xlWhole)
Else
Set FR = _
MyR.Find(.Cells(i, 1).Value, FR, xlValues, xlWhole)
End If
.Cells(i, 1).Value = FR.Address(0, 0)
i = i + 1
Next j
Set FR = Nothing
Loop While i <= ErW
.Range("IV:IV").ClearContents: .Activate
End With
Set MyR = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
