Excel VBA質問箱 IV

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

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


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

49514 / 76736

←次へ　｜　前へ→


	【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

で、どうでしょーか ?

0 hits

▼

【32091】空白を除いて範囲内でFor seiji 05/12/6(火) 12:55