- ベストアンサー
売掛一覧シートで数字の[1]を入力し、納品書シートにデータを印刷する方法
fumufumu_2006の回答
- fumufumu_2006
- ベストアンサー率66% (163/245)
今までは1枚の納品書に1行だけ印刷してたけど、1枚に複数行印刷したいということでしょうか？ 違ったら読み飛ばしてください。 Sub 納品書印刷() Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Set Sheet1 = ThisWorkbook.Worksheets("売掛一覧") Set Sheet2 = ThisWorkbook.Worksheets("納品書") Dim baseRow As Long Dim baseRowA As Integer 'Sheet1.Cells(baseRow, 1).Valueの値(印刷が必要かのフラグにも使う) ' 4行目から、2列目（日付）が空になるまでループ baseRow = 4 Do While (Sheet1.Cells(baseRow, 2).Value <> "") '1列目（A列）に数字の1以上が入っていた時のみ印刷対象 If Sheet1.Cells(baseRow, 1).Value >= 1 Then '1列目（A列）が１の場合 If Sheet1.Cells(baseRow, 1).Value = 1 Then 'それ以前に印刷設定してある分を印刷(ただし最初(baseRowA=0の場合)は除く) If baseRowA <> 0 Then ' 印刷プレビュー Sheet2.PrintPreview End If '印刷終わったら次に備えて明細削除(最後にクリアしてないのでbaseRowA=0の時も） '最大明細行に合わせて3は変更してください Sheet2.Range("B15").Resize(3, 1).Value = "" Sheet2.Range("Q15").Resize(3, 1).Value = "" Sheet2.Range("H15").Resize(3, 1).Value = "" Sheet2.Range("I15").Resize(3, 1).Value = "" Sheet2.Range("J15").Resize(3, 1).Value = "" End If 'baseRowAを定義 baseRowA = Sheet1.Cells(baseRow, 1).Value If baseRowA = 1 Then '質問の仕様に合わせて、この部分はa=1の場合だけ ' P2 に 2列目の値を代入 ' O3 に 3列目の値を代入等 Sheet2.Range("P2").Value = Sheet1.Cells(baseRow, 2).Value Sheet2.Range("O3").Value = Sheet1.Cells(baseRow, 3).Value Sheet2.Range("O12").Value = Sheet1.Cells(baseRow, 4).Value Sheet2.Range("W8").Value = Sheet1.Cells(baseRow, 5).Value Sheet2.Range("W11").Value = Sheet1.Cells(baseRow, 6).Value End If '明細部分(baseRowAの値で行を変える) Sheet2.Range("B15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 7).Value Sheet2.Range("Q15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 8).Value Sheet2.Range("H15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 9).Value Sheet2.Range("I15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 10).Value Sheet2.Range("J15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 11).Value End If '次の行 baseRow = baseRow + 1 Loop '印刷設定してある分を印刷(ただし印刷データが無かった場合(baseRowA=0の場合)は除く) If baseRowA <> 0 Then ' 印刷プレビュー Sheet2.PrintPreview End If Set Sheet2 = Nothing Set Sheet1 = Nothing End Sub p.s. ANo.2さんの >それから、何ゆえSheet2はRangeを使っているのでしょうか。 これは多分わかります。 印刷する方のシートは画面を見ながら「えーっと、Qは17、Hは8・・・」と調べるのは面倒だからではないでしょうか？ 実は私はそうなってます。 画面の変更がある時変更が楽なので。 本当は名前を定義しておくともっと楽だったりするんですが・・・
関連するQ&A
- 悩んでくれる方募集中！(コード掲載)
いままで4月という名のシートの「A列」のランダムな位置に数字の[ 1 ]を数カ所とびとびで入力して列を選択した場合、選択した列に入っている行データーを合計請求書シートにあてはめて印刷しておりました。（下記コード使用） 悩みですが、プリント（プレビューでも可）したという証に[ 1 ]を入力していたセルに[ 1 ]を消して紫の色を付けたいのですが可能でしょうか。 又、1月から12月までシートと印刷用合計請求書シートからなるブックなのですが、月ごとに下記のコードの月表示のみ変更してコピーして使用しているため、12コードある状態です。 もっとスマートなコードおしえていただけないでしょうか。 よろしくお願いいたします。 Sub 合計請求書印刷4月() Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Set Sheet1 = ThisWorkbook.Worksheets("4月") Set Sheet2 = ThisWorkbook.Worksheets("合計請求書") Dim baseRow As Long ' 7行目から、2列目(顧客名)が空になるまでループ baseRow = 7 i = baseRow j = 1 Do While (Sheet1.Cells(i, 2).Value <> "") If (Sheet1.Cells(i, 1).Value = 1) Then Select Case j Mod 3 Case 1 Sheet2.Range("W8").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B15").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W15").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G15").Value = Sheet1.Cells(i, 9).Value Case 2 Sheet2.Range("W25").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B32").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W32").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G32").Value = Sheet1.Cells(i, 9).Value Case 0 Sheet2.Range("W42").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B49").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W49").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G49").Value = Sheet1.Cells(i, 9).Value ' 印刷プレビュー Sheet2.PrintPreview Case Else End Select j = j + 1 End If i = i + 1 Loop If j Mod 3 = 1 Then End Set Sheet2 = Nothing Set Sheet1 = Nothing Else Sheet2.Range("W42").Value = "" Sheet2.Range("B49").Value = "" Sheet2.Range("W49").Value = "" Sheet2.Range("G49").Value = "" If j Mod 3 = 2 Then Sheet2.Range("W25").Value = "" Sheet2.Range("B32").Value = "" Sheet2.Range("W32").Value = "" Sheet2.Range("G32").Value = "" End If Sheet2.PrintPreview End If Set Sheet2 = Nothing Set Sheet1 = Nothing End Sub
- ベストアンサー
- Visual Basic
- VBEのコードを載せました。何処が間違っているのですか。教えてくださいよろしくお願いいたします。
印刷用紙のひな形がA4の紙のなかに3段になっています。 「sheet4月」は顧客名(B行)、担当者名、他に月の売上金等が並んでい ます。顧客名の横の空白のA行に数字の1を入れて、顧客列を選択しま す。それを「sheet合計請求書」に各項目をあてはめて印刷したいので す。 下記のVBEのコードでは「sheet4月」で選択の顧客が「合計請求書」に 内容が移ると3段とも同じ内容、名前になります。 例えば上から1段目「H商事」、2段目「H商事」、3段目「H商事」といっ た具合です。 それを、3段とも違う顧客の内容にしたいのです。 例えば上から1段目、「H商事」、2段目「K機械」、3段目「V貨物」のよ うにしたいのですがわかりません。数字の1をいれて選択する数は約40 社程度です。 ご指導お願いいたします。 Sub 合計請求書印刷() Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Set Sheet1 = ThisWorkbook.Worksheets("4月") Set Sheet2 = ThisWorkbook.Worksheets("合計請求書") Dim baseRow As Long ' 7行目から、2列目(顧客名)が空になるまでループ baseRow = 7 Do While (Sheet1.Cells(baseRow, 2).Value <> "") '1列目（A列）に1が入っていた時のみ印刷 If (Sheet1.Cells(baseRow, 1).Value = 1) Then ' 1段目 Sheet2.Range("W8").Value = Sheet1.Cells(baseRow, 2).Value Sheet2.Range("B15").Value = Sheet1.Cells(baseRow, 8).Value Sheet2.Range("C15").Value = Sheet1.Cells(baseRow, 10).Value Sheet2.Range("W15").Value = Sheet1.Cells(baseRow, 5).Value ' 2段目 baseRow = baseRow + 1 Sheet2.Range("W25").Value = Sheet1.Cells(baseRow, 2).Value Sheet2.Range("B32").Value = Sheet1.Cells(baseRow, 8).Value Sheet2.Range("C32").Value = Sheet1.Cells(baseRow, 10).Value Sheet2.Range("W32").Value = Sheet1.Cells(baseRow, 5).Value '3段目 baseRow = baseRow + 1 Sheet2.Range("W42").Value = Sheet1.Cells(baseRow, 2).Value Sheet2.Range("B49").Value = Sheet1.Cells(baseRow, 8).Value Sheet2.Range("C49").Value = Sheet1.Cells(baseRow, 10).Value Sheet2.Range("W49").Value = Sheet1.Cells(baseRow, 5).Value ' 印刷プレビュー Sheet2.PrintPreview End If baseRow = baseRow Loop Set Sheet2 = Nothing Set Sheet1 = Nothing End Sub よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- 特定の文字以外を入力すると別シートに表記する方法
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim StrRow As Long Dim TgtCol As Long Dim MaxRow As Long Dim ChgRow As Long Dim PutSh1 As Worksheet Dim PutSh2 As Worksheet Dim PutSh3 As Worksheet Dim PutCol As Long Dim PutRow As Long Dim ChgRng1 As Range Dim ChgRng2 As Range Dim ChgRng3 As Range StrRow = 5 MaxRow = 35 If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub Set PutSh1 = ThisWorkbook.Sheets("Sheet2") Set PutSh2 = ThisWorkbook.Sheets("Sheet3") Set PutSh3 = ThisWorkbook.Sheets("Sheet4") With ThisWorkbook.Sheets("Sheet1") Set ChgRng1 = Range(.Cells(StrRow, 3), .Cells(MaxRow, 3)) 'C列 Set ChgRng2 = Range(.Cells(StrRow, 5), .Cells(MaxRow, 5)) 'E列 Set ChgRng3 = Range(.Cells(StrRow, 7), .Cells(MaxRow, 7)) 'G列 End With ChgRow = Target.Row If Not Intersect(Target, ChgRng1) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh1, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng2) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh2, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng3) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh3, ChgRow, Target.Value End If End Sub 以前質問させて頂いた内容で追加の質問です。 Sheet1の指定したセルに「ー（ハイフン）」の文字がある時は、Sheet2〜4に転送（表記）しない方法を追加する場合はどの様にすれば宜しいでしょうか？
- ベストアンサー
- Excel（エクセル）
- VBA コピペ Range エラー
いつもありがとうございます。 https://okwave.jp/qa/q9586463.html この質問のコードを自力で実務用に改変中です。 GetShe.Range(Cells(RowCnt, 1), Cells(RowCnt, 2)).Copy PutShe.Cells(PutRowCnt, 1) ↑このコードでRangeメソッドが失敗しましたというエラーが出るのですが、超初心者のため、原因がわかりません。 GetSheシートのRowCnt行の1列目と2列目をコピーして、PutSheシートのPutRowCnt行の1列目に貼り付けしたいです。 ○番目のシート、行という意味です。 お願いします。 Sub msukei6() ' 変数を宣言 Dim GetShe As Worksheet Dim PutShe As Worksheet Dim SheCnt As Long Dim RowCnt As Long Dim ColCnt As Long Dim PutRowCnt As Long Dim x As Long ' このブックに何シートあるか調べる SheCnt = ThisWorkbook.Worksheets.Count ' "集計"シートが抽出先である Set PutShe = ThisWorkbook.Worksheets("集計") PutRowCnt = 9 For SheCnt = 4 To 6 ' コピー元は4シート目～6シート目 Set GetShe = ThisWorkbook.Worksheets(SheCnt) ' 各シートの氏名をカウントする x = WorksheetFunction.CountA(GetShe.Range("b3:b100")) Do For RowCnt = 3 To x + 3 ' コピー元は3行目からコピーする If GetShe.Cells(RowCnt, Worksheets("集計").Cells(4, 2)) <> "" Then PutRowCnt = PutRowCnt + 1 GetShe.Range(Cells(RowCnt, 1), Cells(RowCnt, 2)).Copy PutShe.Cells(PutRowCnt, 1) End If Next RowCnt Exit Do Loop Next SheCnt End Sub
- ベストアンサー
- Excel（エクセル）
- カットして隣のB列に順番にペーストするマクロ
発注と納品の確認マクロを作成しました。 Sheet1の列を検索して、Sheet2にあればその数字のあるセルを赤くするのですが、 それを以下のように変更することは可能でしょうか？ Sheet1の列を検索して、Sheet2にあれば、Sheet2上でその数字をカットして隣のB列に上から順番にペーストします。 宜しくお願いします。 Sub 発注と納品の確認マクロ() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If myCt = 0 Then c2.Interior.ColorIndex = 3 Else c2.Interior.ColorIndex = 43 End If myCt = myCt + 1 End If Next c2 If myCt = 0 Then c1.Interior.ColorIndex = 6 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub
- ベストアンサー
- その他MS Office製品
- 連続印刷について
顧客名簿を作成し連続印刷により、市販されているようなアドレス帳の レイアウトで印刷したいのですが、以下の様に13人分の印刷をすると 次の連続印刷では1つ繰り上がって、印刷されるだけとなってしまいました。 次ページの印刷からは、14行めから更にその次では28行目からと 印刷設定をしたいのですが、どうすれば宜しいのでしょうか？ 別シートに印刷用のレイアウトをVLOOKUPで作成し、更に別シートで印刷設定を行っています。 初心者なりに見よう見まねで作ってみたのですが・・・・ 説明が下手で分かりにくく申し訳ありません。 護教授宜しくお願い致します。 Sub 連続印刷1() ' Dim mycounter As Integer Dim sita1 As Integer Dim migi1 As Integer mycounter = 1 sita1 = Sheets("設定").Cells(4, 2) migi1 = Sheets("設定").Cells(5, 2) For mycounter = 1 To 5 Sheets("顧客名簿").Select Range("O2").Value = Sheets("住所録").Cells(mycounter + 1, 1) Range("O6").Value = Sheets("住所録").Cells(mycounter + 2, 1) Range("O10").Value = Sheets("住所録").Cells(mycounter + 3, 1) Range("O14").Value = Sheets("住所録").Cells(mycounter + 4, 1) Range("O18").Value = Sheets("住所録").Cells(mycounter + 5, 1) Range("O22").Value = Sheets("住所録").Cells(mycounter + 6, 1) Range("O26").Value = Sheets("住所録").Cells(mycounter + 7, 1) Range("O30").Value = Sheets("住所録").Cells(mycounter + 8, 1) Range("O34").Value = Sheets("住所録").Cells(mycounter + 9, 1) Range("O38").Value = Sheets("住所録").Cells(mycounter + 10, 1) Range("O42").Value = Sheets("住所録").Cells(mycounter + 11, 1) Range("O46").Value = Sheets("住所録").Cells(mycounter + 12, 1) Range("O50").Value = Sheets("住所録").Cells(mycounter + 13, 1) Range(Cells(1, 1), Cells(sita1, migi1)).Select Selection.PrintOut Copies:=Sheets("設定").Cells(6, 2) Next ' End Sub
- ベストアンサー
- Visual Basic
- 顧客番号を指定して印刷するには？
別シートに印刷用のレイアウトを作成し、更に別シートで印刷設定を行っています。 その印刷設定のページには、印刷開始顧客番号 印刷終了顧客番号とセルを作り、そこで顧客番号を指定して連続印刷したいのですが、今の状況だと、For MyCounter 1 to 5の5の部分を変え残りは手動で入力という方法で印刷しています。 顧客番号のみで連続印刷する為にはどうすれば宜しいのでしょうか？ 宜しくお願いいたします。 ---------------------------------------------------------------- Sub 連続印刷2() Dim mycounter As Integer Dim sita1 As Integer Dim migi1 As Integer mycounter = 1 sita1 = Sheets("設定2").Cells(4, 2) migi1 = Sheets("設定2").Cells(5, 2) For mycounter = 1 To 5 Sheets("レイアウト2").Select Range("O2").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 2, 1) Range("O6").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 3, 1) Range("O10").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 4, 1) Range("O14").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 5, 1) Range("O18").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 6, 1) Range("O22").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 7, 1) Range("O26").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 8, 1) Range("O30").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 9, 1) Range("O34").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 10, 1) Range("O38").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 11, 1) Range("O42").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 12, 1) Range("O46").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 13, 1) Range("O50").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 14, 1) Range(Cells(1, 1), Cells(sita1, migi1)).Select Selection.PrintOut Copies:=Sheets("設定2").Cells(6, 2) Next End Sub
- ベストアンサー
- Visual Basic
- VBA .WorksheetFunctionについて
Dim DestBook As Workbook Dim pathmacrobook As String Dim namebook As String Dim myb As Range Dim r As Long Application.ScreenUpdating = False ThisWorkbook.Activate pathmacrobook = ThisWorkbook.Path & "\" & Worksheets("sheet1").Cells(1, 3).Value & "\" Set DestBook = Workbooks("残高集計用.xls") namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set myb = DestBook.Worksheets("sheet3").Range("A65536").End(xlUp) With Workbooks.Open(pathmacrobook & namebook) r = aplication.WorksheetFunction.MatchThisWorkbook.Worksheets("sheet1") .Range("C3:AH3"), namebook.Worksheets("sheet1").Range("C"), 0) If r > 0 Then .Close False Else With Workbooks.Open(pathmacrobook & namebook) .Worksheets("Sheet1").UsedRange.Offset(1).Copy myb.Offset(1) lngREC = lngREC + 1 .Close False End With End If namebook = Dir() Loop Set DestBook = Nothing MsgBox lngREC & "日分" & "読込完了しました" 上記のコードについてですが、修飾子が不正です。や、 Loopに対するDoがありません等エラーが出てしまいます。 やりたい事は、"namebook"を開いた時、"Thisworkbook"のsheet3のC列に"namebook"のsheet1のC列があれば、 "namebook"閉じ、そうでなければコピーするというようにしたいです。 どなたかご教授お願いします。
- ベストアンサー
- オフィス系ソフト
- 指定セルへ転記するマクロで値が無い場合固定値転記
シート２の1行目の指定したセルの値をシート１の指定セルに 転記を行いシート１が印刷。 印刷後はシート２の2行目の指定したセルの値をシート１の指定したセルに 転記してシート１が印刷。 シート２にデータが無くなったら停止という以下のマクロにて シート２のＯ列はシート１のセルA19に順次転記なのですが Ｏ列は運用上空白が有る場合が判明した為 値がある場合はその値を転記、値が無い場合は半角で ZZZ と 転記をしたいのですがどこを変更していいのか分かりません。 よろしくお願いします。 Sub データ転記() Dim myRng(1 To 23) Dim cpRng Dim i As Integer Dim n As String, myStr As String With Sheets("Sheet2") Set myRng(1) = .Range("B2") Set myRng(2) = .Range("C2") Set myRng(3) = .Range("D2") Set myRng(4) = .Range("D2") Set myRng(5) = .Range("D2") Set myRng(6) = .Range("E2") Set myRng(7) = .Range("E2") Set myRng(8) = .Range("F2") Set myRng(9) = .Range("F2") Set myRng(10) = .Range("H2") Set myRng(11) = .Range("J2") Set myRng(12) = .Range("K2") Set myRng(13) = .Range("K2") Set myRng(14) = .Range("L2") Set myRng(15) = .Range("M2") Set myRng(16) = .Range("N2") Set myRng(17) = .Range("O2") Set myRng(18) = .Range("P2") Set myRng(19) = .Range("Q2") Set myRng(20) = .Range("R2") Set myRng(21) = .Range("S2") Set myRng(22) = .Range("U2") Set myRng(23) = .Range("G2") End With cpRng = Split("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,G5", ",") '転記先配列化 With Sheets("Sheet1") .Range("B10,G3,F10,F13,G10,G13,L10,E19,F19,J19,O7,O8,C19,D10,D13,A19,O4,O5").NumberFormatLocal = "@" Do While myRng(1) <> "" For i = 1 To 23 .Range(cpRng(i - 1)).Value = myRng(i).Value Next .Range("C3,C13").Value = Left(.Range("O3").Value, 10) .Range("C10").Value = Mid(.Range("O3"), 11, 6) .Range("O7").Value = Format(Range("O6").Value, "0000000") .Range("O8").Value = Format(Range("J19").Value, "0000000") Call 加工01 Call 加工02 '印刷 .PrintOut For i = 1 To 23 Set myRng(i) = myRng(i).Offset(1) Next i Loop .Range("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,C3,C10,C13,C19,D10,D13,O8,O7,G5").ClearContents End With For i = 1 To 23 Set myRng(i) = Nothing Next MsgBox "印刷終了" Sheets("Sheet2").Select Cells.Select Selection.Delete Shift:=xlUp Sheets("Sheet1").Select Range("C3").Select End Sub
- ベストアンサー
- オフィス系ソフト
- マクロのFINDメソッドで質問です。
マクロの初心者で、いつもお世話になっております。 FINDメソッドを使って別々のシートから同じIDを探す処理をしたいのですが、IDが片方にしか無い場合に検索2rangeが"nothing"になってしまい止まってしまいます。 抜粋ですか以下の様にコーディングしました。 解る方がいましたらアドバイスをお願いします。 IDはIDがセットされている列です。 シート２を上から１つずつ見ていき、 シート１から該当するIDを探す処理をします。 最終的には該当したIDの行数を記憶して、 シート１とシート２をマッチングさせたいのですが。 Dim 検索range As Range Dim 検索2range As Range ID = Sheet2.Cells(LOOP_C1, 検索列).Value Set 検索Range = Range(Sheet1.Cells(F2TOP,検索列),Sheet1.Cells(LASTRow, 検索列)) Set 検索2range = 検索Range.Find(What:=ID, LookAt:=xlWhole, SearchOrder:=xlByRows, searchformat:=True).Row ※ If 検索2range Is Nothing Then Else 検索2range.Activate End If ・ ・ ・ ※の箇所で止まってしまいます。
- ベストアンサー
- オフィス系ソフト
補足
ご回答ありがとうございます。バッチリできていて文句の付けようがありませんでした。まさに希望していたものズバリでございます。 ありがとうございます。 恐縮ですがもう一問お付き合いお願いできないでしょうか。 それは 今回のシートにおいてA列に[1][2][3]にて選択してプリントした時、プリントしたという証にB列のセルに紫の色を付けたいのですが可能でしょうか。 でも、プリントプレビューでは色を付けたくありません。 [1][2][3]によって色を変ず、紫1色で良いです。 よろしくお願いできないでしょうか。