Excel VBA質問箱 IV

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

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


5955 / 76732 ←次へ | 前へ→

【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   '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
繰り返しますが、シートが選択されていない状態で、セルを直接選択することは
できません。

0 hits

【76375】[無題] ペンネーム船長 14/11/9(日) 23:57 質問[未読]
【76376】Re:[無題] γ 14/11/10(月) 0:10 発言[未読]
【76377】Re:[無題] γ 14/11/10(月) 7:06 発言[未読]
【76381】Re:[無題] γ 14/11/11(火) 22:38 発言[未読]
【76382】Re:[無題] ペンネーム船長 14/11/12(水) 0:15 発言[未読]
【76383】Re:[無題] γ 14/11/12(水) 6:13 回答[未読]
【76390】Re:[無題] ペンネーム船長 14/11/14(金) 0:11 お礼[未読]

5955 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free