| |
こんばんは
一度、試してみてください。
（べた書きですが）
Sub セル統合()
Dim i As Long, Ch As Boolean, Sp, Sp1, dd, Da As String, Da1 As String
Dim g As Long, w As Long, k As Long, m As Long, o As Long, q As Long
Dim s As Long, u As Long, Co As Long, ii As Long
For i = 8 To 77
Ch = True
g = Cells(i, 7).Value
w = Cells(i, 10).Value
k = Cells(i, 11).Value
m = Cells(i, 13).Value
o = Cells(i, 15).Value
q = Cells(i, 17).Value
s = Cells(i, 19).Value
u = Cells(i, 21).Value
Select Case Cells(i, 5).Value
Case "A"
Da = "S/_,_M/_,_L/_,_O/_,_XO/_,"
Da1 = g & "_" & w & "_" & k & "_" & m & "_" & o
Case "B"
Da = "M/_,_L/_,_O/_,"
Da1 = w & "_" & k & "_" & m
Case "C"
Da = "フリー/"
Da1 = q
Ch = False
Case "D"
Da = "25-27cm/"
Da1 = s
Ch = False
Case "E"
Da = "サイズなし/"
Da1 = u
Ch = False
Case "F"
Da = "S/_,_M/_,_L/_,_O/_,"
Da1 = g & "_" & w & "_" & k & "_" & m
End Select
If Ch = False Then
If Da1 <> 0 Then
Cells(i, 24) = Da & Da1
End If
Else
Sp = Split(Da, "_")
Sp1 = Split(Da1, "_")
Co = 0
For ii = 0 To UBound(Sp1)
If Sp1(ii) <> "0" Then
dd = dd & Sp(ii + Co) & Sp1(ii) & Sp(ii + Co + 1)
Co = Co + 1
End If
Next ii
Cells(i, 24) = dd
End If
Erase Sp: Erase Sp1: Da = "": Da1 = "": dd = ""
Next i
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
