Excel VBA質問箱 IV

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

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


49510 / 76732 ←次へ | 前へ→

【32132】Re:sheet2として
回答  Kein  - 05/12/6(火) 21:09 -

引用なし
パスワード
   Sub MyPrint()
  Dim Sh1 As Worksheet, Sh2 As Worksheet
  Dim Snum As Long, Lnum As Long
  Dim Ck As Variant

  Set Sh1 = Worksheets("Sheet1")
  Set Sh2 = Worksheets("Sheet2")
  If WorksheetFunction.Count(Sh2.Range("B1:C1")) < 2 Then GoTo ELine
  Snum = CLng(Sh2.Range("B1").Value)
  Lnum = CLng(Sh2.Range("C1").Value)
  With Application
   If IsError(.Match(Snum, Sh1.Range("A:A"), 0)) Then GoTo ELine
   If IsError(.Match(Lnum, Sh1.Range("A:A"), 0)) Then GoTo ELine
   For i = Snum To Lnum
     Ck = .Match(i, Sh1.Range("A:A"), 0)
     If Not IsError(Ck) Then
      Sh2.Cells(3, 2).Value = Sh1.Cells(Ck, 2).Value
      Sh2.Cells(4, 2).Value = Sh1.Cells(Ck, 3).Value
      Sh2.Cells(5, 2).Value = Sh1.Cells(Ck, 4).Value
      Sh2.Range("A3:B5").PrintOut Copies:=1
     End If
   Next i
  End With
ELine:
  Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

または

Sub MyPrint2()
  Dim Sh1 As Worksheet, Sh2 As Worksheet
  Dim Snum As Long, Lnum As Long
  Dim Ck1 As Variant, Ck2 As Variant
  Dim MyR As Range, C As Range

  Set Sh1 = Worksheets("Sheet1")
  Set Sh2 = Worksheets("Sheet2")
  If WorksheetFunction.Count(Sh2.Range("B1:C1")) < 2 Then GoTo ELine
  Snum = CLng(Sh2.Range("B1").Value)
  Lnum = CLng(Sh2.Range("C1").Value)
  With Application
   Ck1 = .Match(Snum, Sh1.Range("A:A"), 0)
   Ck2 = .Match(Lnum, Sh1.Range("A:A"), 0))
  End With
  If IsError(Ck1) Or IsError(Ck2) Then GoTo ELine
  On Error GoTo ELine
  Set MyR = Sh1.Range("A" & Ck1 & ":A" & Ck2).SpecialCells(2, 1)
  For Each C In MyR
   With Sh2.Range("B3:B5")
     .Value = WorksheetFunction _
     .Transpose(C.Offset(, 1).Resize(, 3).Value)
     .PrintOut Copies:=1
   End With
  Next
  Set MyR = Nothing
ELine:
  Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

で、どうでしょーか ?

4 hits

【32091】空白を除いて範囲内でFor seiji 05/12/6(火) 12:55 質問
【32093】Re:空白を除いて範囲内でFor かみちゃん 05/12/6(火) 13:01 発言
【32094】Re:空白を除いて範囲内でFor seiji 05/12/6(火) 13:13 発言
【32096】Re:空白を除いて範囲内でFor かみちゃん 05/12/6(火) 13:16 発言
【32141】Re:空白を除いて範囲内でFor seiji 05/12/6(火) 22:56 お礼
【32097】Re:空白を除いて範囲内でFor Kein 05/12/6(火) 13:24 発言
【32104】Re:空白を除いて範囲内でFor seiji 05/12/6(火) 15:30 質問
【32105】Re:空白を除いて範囲内でFor seiji 05/12/6(火) 15:35 質問
【32118】Re:空白を除いて範囲内でFor かみちゃん 05/12/6(火) 16:34 発言
【32107】Re:空白を除いて範囲内でFor Kein 05/12/6(火) 15:39 発言
【32127】sheet1として seiji 05/12/6(火) 19:57 質問
【32128】sheet2として seiji 05/12/6(火) 20:04 質問
【32130】Re:空白を除いて範囲内でFor かみちゃん 05/12/6(火) 20:13 発言
【32132】Re:sheet2として Kein 05/12/6(火) 21:09 回答
【32140】Re: seiji 05/12/6(火) 22:53 お礼

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