マクロ記述の意味

このQ&Aのポイント
  • マクロ記述の意味を教えてください。
  • 下記のようなマクロが記述されていますが、どのような動作をしているのか教えてください。
  • マクロの記述がわかりません。説明していただけますか?
回答を見る
  • ベストアンサー

マクロ記述の意味

下記のようなマクロがかかれているのですが 記述の意味がわかりません。 教えてください。 Dim h On Error Resume Next Sheets("滞留在庫表").Select With Application.WorksheetFunction For h = 2 To Range("C9999").End(xlUp).Row Cells(h, "V") = "****" Cells(h, "V") = .VLookup(.Replace(String(18, "?"), 8, 1, Mid(Cells(h, "C"), 8, 1)), _ Sheets("表示再設定マスタ").Range("A5:B22"), 2, False) Next h End With

noname#72697
noname#72697

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

>Sheets("滞留在庫表").Select シート「滞留在庫表」をアクティブに。 >With Application.WorksheetFunction エクセル関数をVBAで使いますよ~。 >For h = 2 To Range("C9999").End(xlUp).Row 2行目から、C列の値が入ってるセル内で一番下の行まで以下を繰り返し。 >Cells(h, "V") = "****" V列目のセルに「****」と入れる。 で、次は長いのでこまごまと説明します。 >String(18, "?") 「?」を18個並べた文字列。…(1) >Mid(Cells(h, "C"), 8, 1)) C列目のセルの値の8文字目の文字。…(2) >.Replace(String(18, "?"), 8, 1, Mid(Cells(h, "C"), 8, 1) (1)の8文字目を(2)で置換したもの。EXCEL関数のREPLACEを実行したのと同じ。…(3) >.VLookup(.Replace(String(18, "?"), 8, 1, Mid(Cells(h, "C"), 8, 1)), _ >Sheets("表示再設定マスタ").Range("A5:B22"), 2, False) シート「表示再設定マスタ」のA5:B22のA列と(3)が一致する行のB列の値。 =VLOOKUP((3),'表示再設定マスタ'!A5:B22, 2, FALSE) を実行したのと同じ。 >Next h 繰り返し範囲終わり。 >End With エクセル関数をVBAで使いますよ~。の範囲終わり。

関連するQ&A

  • VBAの転記について

    With Sheets("入力") '3行目~22行目まで For i = 5 To 24 SheetName = Sheets("入力").Cells(i, "C").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, "C").Value U最終行 = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 If U最終行 = 39 Then Sheets(SheetName2).Copy BEFORE:=ActiveSheet Sheets(SheetName).Delete End If If Err.Number = 0 Then A = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("C" & A).Value = .Cells(i, "G").Value Sheets(SheetName2).Range("D" & A).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("E" & A).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("F" & A).Value = .Cells(i, "N").Value Sheets(SheetName2).Range("G" & A).Value = .Cells(i, "P").Value Sheets(SheetName2).Range("H" & A).Value = .Cells(i, "R").Value Sheets(SheetName2).Range("I" & A).Value = .Cells(i, "T").Value Sheets(SheetName2).Range("K" & A).Value = .Cells(i, "V").Value Sheets(SheetName2).Range("L" & A).Value = .Cells(i, "X").Value ElseIf .Cells(i, "C").Value <> "" Then G = Sheets("原紙").Range("C65536").End(xlUp).Row + 1 Sheets("原紙").Range("B1").Value = .Cells(i, "D").Value Sheets("原紙").Range("B4").Value = .Cells(2, "D").Value Sheets("原紙").Range("C" & G).Value = .Cells(i, "G").Value Sheets("原紙").Range("D" & G).Value = .Cells(i, "I").Value Sheets("原紙").Range("E" & G).Value = .Cells(i, "L").Value Sheets("原紙").Range("F" & G).Value = .Cells(i, "N").Value Sheets("原紙").Range("G" & G).Value = .Cells(i, "P").Value Sheets("原紙").Range("H" & G).Value = .Cells(i, "R").Value Sheets("原紙").Range("I" & G).Value = .Cells(i, "T").Value Sheets("原紙").Range("K" & G).Value = .Cells(i, "V").Value Sheets("原紙").Range("L" & G).Value = .Cells(i, "X").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next i End With On Error GoTo 0 上記のVBAを作成しましたが、 C行の値ごとの転記(G~Xの値)が出来ません。 どこが間違いか教えていただけないでしょうか。

  • 例題を繰り返しマクロで記述したい

    ネットや本でマクロを作成しているいて、あまりマクロの意味も分からず作成しています。 下記のマクロの記述を繰り返しマクロで記述したいので、御指導願います。(H列で終わっていますが、できれば隣のセルが空白になるまで繰り返すようにしたい。) あと、自分の欲しい内容に修正出来るように、記述の意味などもコメントして頂けたら嬉しいのですが・・・。よろしくお願いします。 Sub 最終履歴を表示する(2)() Range("C4").NumberFormatLocal = "G/標準" Range("C4").Value = Application.WorksheetFunction.Max(Range("C6:C10000")) Range("C4").Replace What:="0", Replacement:="履歴無し", LookAt:=xlWhole Range("C4").NumberFormatLocal = "yyyy/m/d;@" Range("D4").NumberFormatLocal = "G/標準" Range("D4").Value = Application.WorksheetFunction.Max(Range("D6:D10000")) Range("D4").Replace What:="0", Replacement:="履歴無し", LookAt:=xlWhole Range("D4").NumberFormatLocal = "yyyy/m/d;@" Range("E4").NumberFormatLocal = "G/標準" Range("E4").Value = Application.WorksheetFunction.Max(Range("E6:E10000")) Range("E4").Replace What:="0", Replacement:="履歴無し", LookAt:=xlWhole Range("E4").NumberFormatLocal = "yyyy/m/d;@" Range("F4").NumberFormatLocal = "G/標準" Range("F4").Value = Application.WorksheetFunction.Max(Range("F6:F10000")) Range("F4").Replace What:="0", Replacement:="履歴無し", LookAt:=xlWhole Range("F4").NumberFormatLocal = "yyyy/m/d;@" Range("G4").NumberFormatLocal = "G/標準" Range("G4").Value = Application.WorksheetFunction.Max(Range("G6:G10000")) Range("G4").Replace What:="0", Replacement:="履歴無し", LookAt:=xlWhole Range("G4").NumberFormatLocal = "yyyy/m/d;@" Range("H4").NumberFormatLocal = "G/標準" Range("H4").Value = Application.WorksheetFunction.Max(Range("H6:H10000")) Range("H4").Replace What:="0", Replacement:="履歴無し", LookAt:=xlWhole Range("H4").NumberFormatLocal = "yyyy/m/d;@" End Sub

  • マクロで教えてください。

    sheet1のA列にある図番を参照しsheet2のA列の機種名に適合する行全体に sheet1のB列にある色を塗りたいのですが、マクロを教えていただけますでしょうか? sheet2のBのセル色を塗るマクロはわかりました。↓です。 Sub macro1() Dim c As Range, myR As Variant With Sheets("Sheet2") For Each c In .Range("a2", .Cells(Rows.Count, "a").End(xlUp)) myR = Application.Match(c.Value, Sheets("sheet1").Columns(1), 0) If Not IsError(myR) Then c.Offset(, 1).Interior.ColorIndex = Sheets("sheet1").Cells(myR, "B").Interior.ColorIndex End If Next End With End Sub 上記マクロですとBセルのみ色が塗られてしまうので行全体を塗るマクロを教えてください。 よろしくお願い致します。

  • エクセル重複行統合マクロの意味

    Tom04さんの回答で 以下のとても素晴らしいマクロがあり、 使用させていただきたいのですが、 詳細がわかりません。 少々編集して自分の書類に反映させていただきたく、 マクロの内容を教えていただけませんか? Sub test() 'この行から Dim i, j, k, L As Long Application.ScreenUpdating = False For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column + 1 For k = Cells(Rows.Count, j).End(xlUp).Row To 2 Step -1 If Cells(k, j) <> "" And WorksheetFunction.CountIf _ (Range(Cells(2, 1), Cells(k, 1)), Cells(k, 1)) > 1 Then L = WorksheetFunction.Match(Cells(k, 1), Columns(1), False) Cells(k, j).Cut Destination:=Cells(L, j) End If Next k Next j Next i For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountA(Rows(i)) = 1 Then Rows(i).ClearContents End If Next i Application.ScreenUpdating = True End Sub 'この行まで

  • エクセル2003マクロの機能追加

    Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value If Range("A" & 行1).Font.Bold Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub 元データ AAAA5 9601  950 BBBB1 9660  150 ASAS9 9654  -50 AXCW5 9603  1375 以下の用にマクロで変換する機能を追加したいのです AAAA5 9601  950 BBBB1-1 9660  150 BBBB1-2 9660  150 ASAS9 9654  50 AXCW5 9603  1375 宜しくおねがいします。

  • マクロ シート削除の記述確認願います

    いつも回答して頂き、感謝しています。 ネットで調べながら、使えそうな記述を少し修正し、シート削除のマクロを記述してみました。 削除するシートの対象は、別のシートに一覧で載せてあります。 ちなみに、シートを挿入する時も、上記で参照する一覧を参照して作ってあります。 こんな場合もあるから、こんな感じに記述した方がいいよって意見がありましたら、教えてください。宜しくお願い致します。 Sub 作業名別のシートを削除する() Dim h As Range On Error Resume Next Application.DisplayAlerts = False With Worksheets("作業名一覧") .Activate For Each h In .Range(.Range("B2"), Range("B65536").End(xlUp)) Worksheets(h.Value).Delete Next End With Application.DisplayAlerts = True End Sub

  • エクセル 決算マクロ

    Dim s Dim h As String Private Sub Worksheet_SelectionChange(ByVal Target As Range) h = Sheets("決算").Cells(3, 2).Value For Each ws In Worksheets s = ws.Index Next ws For k = 5 To s Step 1 Set KaMoku = Sheets(k).Range("D3:J103").Columns(1) MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) MyUNo = KaMoku.Cells(MyRNo).Offset(, 4) n = n + MyUNo Sheets("決算").Cells(3, 5).Value = n Next k End Sub 自治会の決算書を作りたいので上記のようなマクロを、インターネットで調べながら 私の知識のない頭をフル回転させて書いてみたのですが。 h = Sheets("決算").Cells(3, 2).Valueで、hへの値の代入が一つのセルからの代入ではなくて h = Sheets("決算").Range("B3:B103").Valueのように範囲から文字をさがしたいのです。 それと MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) AND MySNo = Application.WorksheetFunction.Match(K, KoKaMoku, 0) のように、この文字が同じで、次の列のこの文字も同じ時に MyUNo = KaMoku.Cells(MySNo).Offset(, 4) 4列目の値を n = n + MyUNo Sheets("決算").Cells(3, 5).Value =(ではなくて) ここも、一致した文字のあるセルの隣のセルに数値を入れたいのですが、うまくいきません。どうか私に、あなたの素晴らしい知恵をかしてください。 お願いします。

  • Next,End Withのエラー

    Sub 入力() If Sheets("入力").Range("D3").Value = "" Then MsgBox "客先名を入力して下さい" Else Dim K最終行 As Long Dim T最終行 As Long Dim i As Integer With Sheets("入力") For i = 3 To 12 If .Cells(i, "H").Value <> "" Then U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1 If U最終行 = 461 Then MsgBox "注文書がいっぱいです" Exit Sub Else End If E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1 Sheets("営業確認").Range("k" & E最終行).Value = .Cells(i, "b").Value Sheets("営業確認").Range("b" & E最終行).Value = .Cells(i, "c").Value Sheets("営業確認").Range("c" & E最終行).Value = .Cells(i, "d").Value Sheets("営業確認").Range("d" & E最終行).Value = .Cells(i, "e").Value Sheets("営業確認").Range("g" & E最終行).Value = .Cells(i, "h").Value Sheets("営業確認").Range("f" & E最終行).Value = .Cells(i, "i").Value Sheets("営業確認").Range("i" & E最終行).Value = .Cells(i, "m").Value Sheets("営業確認").Range("h" & E最終行).Value = .Cells(i, "p").Value Else End If Select Case .Cells(i, "o").Value Case "北" K最終行 = Sheets("北").Range("h65536").End(xlUp).Row + 1 Sheets("北").Range("B" & K最終行).Value = .Cells(3, "C").Value Sheets("北").Range("c" & K最終行).Value = .Cells(3, "b").Value Case "中" T最終行 = Sheets("中").Range("H65536").End(xlUp).Row + 1 Sheets("中").Range("b" & T最終行).Value = .Cells(3, "c").Value Sheets("中").Range("c" & T最終行).Value = .Cells(3, "b").Value End Select Exit Sub Dim Dummy As Worksheet Dim SheetName As String Dim OTA As Long Dim GEN As Long Dim SheetName2 As String With Sheets("入力") '3行目~22行目まで For j = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, 14).Value 'もしシートがあれば・・・ If Err.Number = 0 Then 'SheetName2は入力シートのN行 SheetName2 = .Cells(i, 14).Value OTA = Sheets(SheetName2).Range("B65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("A7").Value = .Cells(3, "D").Value Sheets(SheetName2).Range("C3").Value = .Cells(3, "C").Value Sheets(SheetName2).Range("B" & OTA).Value = .Cells(i, "H").Value Sheets(SheetName2).Range("I" & OTA).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("F" & OTA).Value = .Cells(i, "K").Value Sheets(SheetName2).Range("H" & OTA).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("J" & OTA).Value = .Cells(i, "M").Value 'シートが無ければ・・・ Else GEN = Sheets("原紙").Range("B65536").End(xlUp).Row + 1 Sheets("原紙").Range("A7").Value = .Cells(3, "D").Value Sheets("原紙").Range("C3").Value = .Cells(3, "C").Value Sheets("原紙").Range("B" & GEN).Value = .Cells(i, "H").Value Sheets("原紙").Range("I" & GEN).Value = .Cells(i, "I").Value Sheets("原紙").Range("F" & GEN).Value = .Cells(i, "K").Value Sheets("原紙").Range("H" & GEN).Value = .Cells(i, "L").Value Sheets("原紙").Range("J" & GEN).Value = .Cells(i, "M").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName Next End With Exit Sub On Error GoTo 0 Sheets("原紙").Select Range("C3:E3,A7,B16:B35,F16:F35,H16:J35").Select Range("H35").Activate Selection.ClearContents Sheets("入力").Select Sheets("入力").Range("D3,G3:J12,L3:M12").Value = "" Sheets("入力").Range("D3").Select Range("B3").Formula = "=IF(D3="""","""",VLOOKUP(D3,'\\Seika-sv01\支店共有\マーケティング用\[担当者リスト.xls]リスト形式'!$B:$D,3,FALSE))" MsgBox "入力が完了しました" End If End Sub 上記のようにマクロを組みましたがエラーが出てしまいます。

  • Excelマクロ 複数条件一致データの抽出方法

    お世話になります。 2個の条件に一致するものを別シートに抽出したいのですが、お知恵を貸してください。 Excelシートで下記のような表があります。 これをL列(品名)かつS列(品質)の条件に一致するデータで新しいシートを作成したいのですが、 その際に新しいシート名は"AA1"のようにしたいのです。 条件がC列(品名)だけであれば下記で動いたのですが…。 (データ) A列 入荷日 I列  品目コード L列 品名 S列 品質 V列 在庫 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 1/1・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・20 2/2・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・BB・・・・・・・・1・・・・・・・・・10 ※以下、最大100品目の行数10000程です。  ↓↓ (実行後希望) シート名 AA1 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 1/1・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・20 2/2・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・10 シート名 AA2 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 シート名 BB1 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 2/3・・・・01・・・・・・・BB・・・・・・・・1・・・・・・・・・10 Sub Sheet抽出() Dim i As Long, Lstrow As Long, myName As String Dim MySht As Worksheet, myFlg As Boolean Application.ScreenUpdating = False With Sheets("sheet1") '準備 For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row myName = .Cells(i, 9) 'シートの存在確認 For Each MySht In Worksheets If MySht.Name = myName Then myFlg = True '既にシート在り!! Sheets(myName).Range("a1") _ .CurrentRegion.Offset(1).ClearContents Exit For End If Next '新規シートの追加 If myFlg = False Then Worksheets.Add.Name = myName End If With Sheets(myName) .Range("A1") = "入荷日" .Range("I1") = "品名コード" .Range("L1") = "品名" .Range("S1") = "品質" .Range("V1") = "在庫" End With myFlg = False Next 'データの転記 For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row myName = .Cells(i, 9).Value .Range("A" & i & ":V" & i).Copy _ Sheets(myName).Cells(Rows.Count, 1).End(xlUp).Offset(1) With Sheets(myName) .Activate Lstrow = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(Rows.Count, 1).End(xlUp).Offset(1, 21) = "" .Cells(Rows.Count, 1).End(xlUp).Offset(1, 21) = _ "=SUM(v2:V" & Lstrow & ")" End With Next End With Sheets("Sheet1").Activate Application.ScreenUpdating = True End Sub 実行後希望のように抽出するには、どうすれば良いのでしょうか? よろしくお願いいたします。

  • VBA 初心者です シートの指定がうまくいかない

    初めまして!VBAを利用してあるシートにある人の名前を他のシートに入力するマクロを組んでいるのですが、この方法でやるとシートの指定がうまくいかず実行時エラーになってしまいます。A個人というシートでボタンを押したら大丈夫なのですが、他のシートにボタンを設置し、押すとエラーになってしまいます…どなたか詳しい方、どうしてこうなるのか、また、どうすればうまく動いてくれるのか教えていただきたいです。 Dim fa As Integer Dim namae As String Dim n As Integer On Error Resume Next n = Worksheets("ランニングスコア").Range("C100000").End(xlUp).Offset(0, 0) With Sheets("A個人") fa = WorksheetFunction.Match(n, Columns(1), 0) namae = Cells(fa, 2) End With Worksheets("ランニングスコア").Range("D100000").End(xlUp).Offset(2, 0) = namae

専門家に質問してみよう