| |
▼さちきょん さん：
こんにちは
>これは、昨日のプログラムの後ろにくっつけていいんですよね？
昨日のプログラムに背景色の変更処理を追加したものです。
昨日のプログラムを今回のプログラムに置き換えていただくと
X列に各サイズの数量を連結した値が入り、各サイズの数量の列の
背景色が変更されるはずです。
以下昨日のコードと置き換えしていただくコード
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(金) 12:24 -
