|
商品2,商品3の有無チェックが必要かもしれないが、
一応、修正版を載せておきます。
Private Sub CommandButton1_Click()
Dim buf As String
Dim wb As Workbook
Dim K As String '管理記号用変数
Dim sh As Worksheet
Dim obj As Range
Dim obj2 As Range
Dim w As String
Dim n As Integer
Dim n2 As Integer
K = ThisWorkbook.Worksheets("ツール").Range("B6").Value '管理記号があるセル
Const path = "C:\Users\●○\Desktop\test\"
buf = Dir(path & "\*商品一覧表" & K & "*.xls")
Set wb = Workbooks.Open(path & buf)
For Each sh In Worksheets
Set obj = sh.Cells.Find(what:="商品1", LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False, MatchByte:=False) '1回目の検索
If Not obj Is Nothing Then '『商品1』があったとき
w = obj.Offset(0, 7).Value 'K列(階数)
n = obj.Offset(0, 3).Value 'G列(数量)
obj.Offset(0, 4).Value = "▲" & n
obj.Offset(0, 5).Value = "0"
obj.Offset(0, -3).Value = "○"
obj.Offset(0, 3).Font.Strikethrough = True '取り消し線を引く
'*****検索出来た行に太線を引きたい*****
With sh.Range(obj.Offset(0, -3), obj.Offset(0, 10)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
If w = "1" Then '商品1が1階にあるとき
Set obj2 = sh.Cells.Find(what:="商品2", LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False, MatchByte:=False) '続けて2回目の検索
n2 = obj2.Offset(0, 3).Value 'G列(数量)
obj2.Offset(0, 4).Value = "+" & n
obj2.Offset(0, 5).Value = n2 + n
obj2.Offset(0, -3).Value = "○"
obj2.Offset(0, 3).Font.Strikethrough = True '取り消し線を引く
'*****検索出来た行に太線を引きたい*****
With sh.Range(obj2.Offset(0, -3), obj2.Offset(0, 10)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End If
If w = "2" Or w = "3" Or w = "4" Or w = "5" Or w = "6" Then
Set obj2 = sh.Cells.Find(what:="商品3", LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False, MatchByte:=False)
n2 = obj2.Offset(0, 3).Value 'G列(数量)
obj2.Offset(0, 4).Value = "+" & n
obj2.Offset(0, 5).Value = n2 + n
obj2.Offset(0, -3).Value = "○"
obj2.Offset(0, 3).Font.Strikethrough = True '取り消し線を引く
'*****検索出来た行に太線を引きたい*****
With sh.Range(obj2.Offset(0, -3), obj2.Offset(0, 10)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End If
End If
w = ""
n = 0
n2 = 0
Next sh
End Sub
繰り返しますが、シートが選択されていない状態で、セルを直接選択することは
できません。
|
|