Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6030 / 76807

←次へ　｜　前へ→


	【76381】Re:［無題］

γ - 14/11/11(火) 22:38 -


	引用なし

	パスワード

商品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　　 'Ｋ列（階数）
　　　　　　n = obj.Offset(0, 3).Value　　 'Ｇ列（数量）
　　　　　　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　 'Ｇ列（数量）
　　　　　　　　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　 'Ｇ列（数量）
　　　　　　　　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
繰り返しますが、シートが選択されていない状態で、セルを直接選択することは
できません。

2 hits

▼

【76375】［無題］ ペンネーム船長 14/11/9(日) 23:57