|
>>▼おにこ さん
また時間ができたので、やっておきました。
私のマクロは、他の皆さんと違って、基本的なことさえ知っていれば、作れるコードで書いています。マクロの記録などもそのまま使っています。
それでも動くことがVBAの最大のメリットではないのかな?
ただし、処理速度が遅くて使いものにならない時は、別途スマートなコードが必要です。
Sub Macro4()
シート名 = ActiveSheet.Name
ActiveSheet.Copy Before:=Sheets(1)
シート名1 = ActiveSheet.Name
Columns("A:Z").Select
Selection.Delete Shift:=xlToLeft
'データ分解()
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="、", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
' 探す()
For n = 1 To 10
p = 0
p1 = 0
For i = 1 To 10
If Cells(n, i) <> "" Then
If Cells(n, i).Value Like "*<*" Then
Cells(n, 33 + p) = Cells(n, i)
p = p + 1
Else
Cells(n, 27 + p1) = Cells(n, i)
p1 = p1 + 1
End If
Else
Exit For
End If
Next
Next
' 結合()
For n = 1 To 10
For i = 1 To 5
If Cells(n, 27 + i) <> "" Then
Cells(n, 27) = Cells(n, 27) & "、" & Cells(n, 27 + i)
Cells(n, 27 + i) = ""
End If
Next
Next
For n = 1 To 10
For i = 1 To 5
If Cells(n, 33 + i) <> "" Then
Cells(n, 33) = Cells(n, 33) & "、" & Cells(n, 33 + i)
Cells(n, 33 + i) = ""
End If
Next
Next
' 貼り付け()
'
Columns("AA:AA").Select
Selection.Copy
Worksheets(シート名).Select
Columns("AA:AA").Select
ActiveSheet.Paste
Worksheets(シート名1).Select
Columns("AG:AG").Select
Selection.Copy
Worksheets(シート名).Select
Columns("AG:AG").Select
ActiveSheet.Paste
Worksheets(シート名1).Delete
End Sub
|
|