|
▼なのは さん:
こんにちは
SampleB の 別案です。
A列以外に (Table. ○○○) があると、A列のものと同等にみなされてしまいますが。
Option Explicit
Dim sh3 As Worksheet
Dim row3 As Long
Sub SampleB_2()
Dim allV As Variant
Dim allStr As String
Dim tblAv As Variant 'Table名の配列 転記シートA列用
Dim i As Long, j As Long, k As Long, x As Long, z As Long
Dim myC As Range
z = WorksheetFunction.CountA(ActiveSheet.UsedRange)
If z = 0 Then
MsgBox "このシートは空白シートです"
Exit Sub
End If
Application.ScreenUpdating = False
allV = Array("") '配列化
ReDim allV(1 To z)
Set sh3 = Worksheets("SHeet3")
sh3.Columns("A:C").ClearContents
tblAv = Array("") '初期化
z = 0
For Each myC In ActiveSheet.UsedRange
If Not IsEmpty(myC.Value) Then
z = z + 1
allV(z) = myC.Value
End If
Next
Set myC = Nothing
allStr = Join(allV, ",")
allStr = Replace(allStr, "(Table.", vbTab & vbCr)
allStr = Replace(allStr, ")", vbTab)
allStr = Replace(allStr, "(", vbTab & vbLf)
allV = Split(allStr, vbTab)
For z = LBound(allV) To UBound(allV)
If Left(allV(z), 1) = vbCr Then
Call tblSet(Mid(allV(z), 2), tblAv)
ElseIf Left(allV(z), 1) = vbLf Then
Call itemSet(Mid(allV(z), 2), tblAv)
End If
Next
sh3.UsedRange.NumberFormatLocal = "@"
Set sh3 = Nothing
Set myC = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub tblSet(ByVal myStr As String, ByRef tblV As Variant)
Dim x As Long
tblV = Split(myStr, ",")
For x = LBound(tblV) To UBound(tblV)
tblV(x) = WorksheetFunction.Trim(tblV(x))
Next
End Sub
Private Sub itemSet(ByVal myStr As String, ByRef tblAv As Variant)
Dim itemV As Variant '( ) 内の要素の配列
Dim tblBV As Variant 'Table名の配列 転記シートB列用
Dim x As Long, z As Long, i As Long, j As Long, k As Long
Dim v As Variant
Dim s As String
tblBV = Array("")
x = InStr(myStr, ";")
If x > 0 Then
z = InStr(x, myStr, "Table.")
If z > 0 Then
Call tblSet(Mid(myStr, z + 6), tblBV)
myStr = Left(myStr, x - 1)
End If
End If
itemV = Split(myStr, ",")
For x = LBound(itemV) To UBound(itemV)
itemV(x) = WorksheetFunction.Trim(itemV(x))
Next
For i = LBound(tblAv) To UBound(tblAv)
For j = LBound(tblBV) To UBound(tblBV)
For k = LBound(itemV) To UBound(itemV)
row3 = row3 + 1
sh3.Range("A" & row3).Value = tblAv(i)
sh3.Range("B" & row3).Value = itemV(k)
sh3.Range("C" & row3).Value = tblBV(j)
Next
Next
Next
End Sub
|
|