| |
▼さちきょん さん：
みなさん，こんにちは
前回投稿のコードは思いっきりミスってました。＾＾；
下記コードに修正します。
ごめんなさいm(_ _)m
Sub セル統合()
Dim v As Integer
Dim i As Integer
Dim strSizeH As Variant
Dim strSize(0 To 7) As String
Dim strTEXT As String
Dim lngEndROW As Long
Dim intRED As Integer
Dim intGREEN As Integer
Dim intBLUE As Integer
lngEndROW = Range("E65536").End(xlUp).Row
If lngEndROW < 8 Then Exit Sub
strSizeH = Split("S/,M/,L/,O/,XO/,フリー/,25-27cm/,サイズなし/", ",")
For v = 8 To lngEndROW
For i = 0 To 7
strSize(i) = IIf(Cells(v, i * 2 + 7).Value = "", "", strSizeH(i) & Cells(v, i * 2 + 7).Value & ",")
Next i
Select Case Cells(v, 5).Value
Case "A"
strTEXT = strSize(0) & strSize(1) & strSize(2) & strSize(3) & strSize(4)
intRED = 255
intGREEN = 0
intBLUE = 0
Case "B"
strTEXT = strSize(1) & strSize(2) & strSize(3)
intRED = 0
intGREEN = 255
intBLUE = 0
Case "C"
strTEXT = strSize(5)
intRED = 0
intGREEN = 0
intBLUE = 255
Case "D"
strTEXT = strSize(6)
intRED = 255
intGREEN = 0
intBLUE = 255
Case "E"
strTEXT = strSize(7)
intRED = 255
intGREEN = 255
intBLUE = 0
Case "F"
strTEXT = strSize(0) & strSize(1) & strSize(2) & strSize(3)
intRED = 0
intGREEN = 255
intBLUE = 255
Case Else
intRED = 255
intGREEN = 255
intBLUE = 255
End Select
If strTEXT <> "" Then
strTEXT = Left(strTEXT, Len(strTEXT) - 1)
Cells(v, 24).Value = strTEXT
strTEXT = ""
End If
For i = 5 To 21 Step 2
Cells(v, i).Interior.Color = RGB(intRED, intBLUE, intGREEN)
Next
Next v
End Sub
|
|
こたつねこ
- 06/1/20(金) 11:49 -
