エクセルVBAで特定の日付を抜き出す方法

このQ&Aのポイント
  • エクセルVBAで特定の日付を探し、抜き出す方法について解説します。
  • 特定の日付を探して抜き出すVBAを組み込んだエクセルファイルの一部に、意味がわからないコードがあります。
  • 「y=1:i=1」というコードの意味について説明します。
回答を見る
  • ベストアンサー

エクセルVBAで解らない部分があります。

エクセルVBAで解らない部分があるのでどなたか教えてください。 ある表から特定の日付を探して抜き出すVBAを組み込んだファイルに下記のような記述がありました。 y=1:i=1 do   set tmp=workbooks("B").sheets(1).rows(2).find(workbooks("A").sheets(1).cells(y,1),lookat:=xlwhole)   if not tmp is nothing then     Workbooks("B").sheets(2).cells(i,1)=workbooks("A").sheets(1).cells(y,1)     '~略~     i=i+1   end if   y=y+1 loop until y=workbooks("A").sheets(1).range("A65536").end(xlup).row この中の「y=1:i=1」がよくわかりません。どなたか解る方どういう意味か教えてくれませんか? よろしくお願いします。

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

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

y = 1: i = 1 と y = 1 i = 1 は同じ意味です。 一行にまとめて書くとそうなります。

asahijp
質問者

お礼

そうだったんですね。おかげでスッキリしました。 どうもありがとうございます。

関連するQ&A

  • エクセルVBA 最終行にデータを追加する

    エクセルのユーザーフォームにチェックリストを用意しました CheckBox1~CheckBox5まであり、 CheckBox1をクリック(true)にすると、セルに“あ” CheckBox2をクリック(true)にすると、セルに“い” CheckBox3をクリック(true)にすると、セルに“う” CheckBox4をクリック(true)にすると、セルに“え” CheckBox5をクリック(true)にすると、セルに“お” を反映させようと思っています たとえば、 ・CheckBox1のみクリック(true)で、A1に“あ” ・CheckBox2のみクリック(true)で、A1に“い” ・CheckBox1、CheckBox3をクリック(true)で、A1に“あ”、A2に“う” ・CheckBox2~CheckBox5をクリック(true)で、A1に“い“、A2に“う“、A3に”え”、A4に“お” といった感じで、選んだチェック項目について、A列においてA1から次々とデータを入力しようとしています そこで、 sheets1.Range("A:A").Clear If CheckBox1.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "あ" End If If CheckBox2.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "い" End If If CheckBox3.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "う" End If If CheckBox4.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "え" End If If CheckBox5.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "お" End If としました (実際は、CheckBoxの名前が1~5と数字ではないので、forは使いませんでした) すると、 CheckBox1~CheckBox5を全てクリック(true)しても、A1に“お”が反映されるだけで“あ”~”え”が入力されません どうすれば、思い通りになるのでしょうか 初歩的な質問だと思うのですが、よろしくお願いします

  • エクセルVBAで。

    お世話になります。 VBA初心者です。 (初心者でもないのですが、しばらく遠ざかっていました。) エクセルVBAの記述内容をコピーし、 エクセルの通常のシートへ貼り付けした際、 記述上「’」で始まる文字は緑色が付いていますが、 通常のシートへ貼り付けした際、黒字になってしまいます。 そこで、下記の様なVBAを記述し、貼り付け後に、 「’」から始まる文字を緑色に着色しようと試みましたが (やはり)うまくいきませんでした。 エクセル関数なんかも織り交ぜたおかしな記述だと思いますが 何となくやりたい事が伝わって頂けるかと思うのですが、 どう修正したら出来ますでしょうか。 ご教授下さいます様、宜しくお願いいたします。   記 Sub 色() Dim y As Integer Dim x As Integer Dim a As Integer mysheet = ActiveSheet.Name For y = 1 To 10 x = Sheets(mysheet).Cells(Rows.Count, y).End(xlUp).Row a = 0 Do Until a > x a = a + 1 If Right(Cells(y, a), 1) = "'" Then Cells(y, a).Select Selection.Font.ColorIndex = 10 End If Loop Next End Sub

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • エクセルVBA セルを参照した文字検索でシートをアクティブにする

    VBA初心者で困っています。 ブックAのシート1の“A1”の値が、同一ブック内の違うシートにあるかどうか検索し、あればそのセルをアクティブにして黄色に色づけ、なければメッセージを返すという処理をVBAで行いたいです。 似たような質問があってそれを参考にしてみましたが どうも上手く動いてくれません。 参考にさせていただいたのは   Set r = Workbooks("ブックB.xls").Sheets("シート1").Columns("A") _     .Find(What:=Workbooks("ブックA.xls").Sheets("シート1").Range("A1").Value, _        LookIn:=xlValues, _        LookAt:=xlWhole, _        SearchOrder:=xlByColumns, _        SearchDirection:=xlNext, _        MatchCase:=True)   If r Is Nothing Then     MsgBox "no data"   Else     Application.Goto r     Set r = Nothing   End If End Sub というコードです どなたか、わかる方教えてください。

  • Excel VBAで文字列の部分一致の文字列を表示

    以前、こちらで頭5文字までの一致で文字列を表示するVBAを教えて頂きました。今回はFINDなどの部分一致での文字列を表示することをしたいのですが、ご教示いただけますと幸いです。 下記はSheet1のA3に文字を5文字以内いれるとSheet2のC列からピックアップしてSheet1のA列に文字列を表示する及びSheet2のB列のデータをSheet1のC列に表示させるVBAです。 Sub Test2() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim SData As String, i As Long, VRet As Variant Dim c As Range, LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") SData = CStr(Ws1.Range("A3").Value) If SData = "" Then Exit Sub i = 5 LastRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row If LastRow < i Then LastRow = i End If Ws1.Range(Ws1.Cells(i, "A"), Ws1.Cells(LastRow, "C")).ClearContents With Ws2 For Each c In .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)) VRet = InStr(1, CStr(c.Value), SData, vbTextCompare) If VRet = 1 And Len(c.Value) >= 10 Then Ws1.Cells(i, "A").Resize(1, 2).Value = c.Resize(1, 2).Value 'とりあえずSheet2のB列のデータ(C列のデータに同期したデータ)をSheet1のC列に Ws1.Cells(i, "C").Value = .Cells(c.Row, "B").Value i = i + 1 End If Next End With End Sub 宜しくお願い致します。

  • エクセル内の同上と書いてあるセルの上をFillDownしたい。

    住所録をもらったのですが、 同じ住所と郵便番号の場合「同上」か「空白」になっていて入力されていません。 見よう見まねでとりあえず郵便番号で1回の住所で1回実行する感じでマクロを作ってみたのですが、 Loop While ~の行で 「オブジェクト変数または With ブロック変数が設定されていません。(Error 91)」 とエラーが出て終わりません。 なぜこのエラーが出るのでしょうか? Sub 同じ() Dim list(2) list(1) = "同上" list(2) = "" tmp2 = Val(InputBox("検索列")) LR = ActiveSheet.Cells(65536, tmp2).End(xlUp).Row For i = 1 To 2 Set 検索 = ActiveSheet.Range(Cells(1, tmp2), Cells(LR, tmp2)).Find(what:=list(i), LookAt:=xlWhole, LookIn:=xlValues) If Not 検索 Is Nothing Then StartAD = 検索.Address Do Cells(検索.Row, tmp2).FillDown Set 検索 = ActiveSheet.Range(Cells(1, tmp2), Cells(LR, tmp2)).FindNext(検索) Loop While Not 検索 Is Nothing And 検索.Address <> StartAD Else End If Next i End Sub

  • Excel VBAで半角

    Excel VBAで半角 A列が半角のときに、B列にoと表示させるために下記のソースを考えたのですがうまくいきません。初歩的な質問だとは思いますがよろしくお願いします。 Sub 半角判定() Dim i For i = 2 To Range("g65536").End(xlUp).Row If Application.Len(Cells(i, 1)) = Application.LenB(Cells(i, 1)) Then Cells(i, 2) ="o" End If Next End Sub

  • 【至急助けて下さい!!】VBAでのIF関数挿入

    VBA初心者です。上級者の方助けてください。 VBAで入力セルを消去後、IF関数をN列に挿入したいです。 挿入したいIF関数のところが解決できればあとの記述はなんとかなります。 ■挿入したいIF関数 =IF(M4=$Y$5,$Z$9,IF(M4=$Y$6,$Z$9,IF(M4=$Y$7,$Z$9,IF(M4=$Y$8,$Z$6,IF(M4=$Y$9,$Z$10,IF(M4=$Y$10,$Z$9,IF(M4=$Y$14,$Z$7,IF(M4=$Y$15,$Z$8,"")))))))) 他関数は下記構文でうまくいくのですが、 IF関数はどのように記述したらよろしいでしょうか。 ■他 ws.Cells(i, jig_col).Value = "=VLOOKUP(F" & i & ",Sheet1!$A$2:$C$358,2,0)" ■現在の記述 Dim ws As Worksheet Dim endrow As Long Dim endcol As Long Dim you_col As Integer Dim gak_col As Integer Dim jig_col As Integer Dim bc_col As Integer Dim chg_col As Integer Dim i As Long '確認メッセージを表示し、「NO」の場合は処理を行わない If MsgBox("入力されている内容をクリアします。よろしいですか?", vbYesNo) = vbNo Then Exit Sub End If '画面の更新を行わない Application.ScreenUpdating = False Set ws = ThisWorkbook.Sheets("シンフォームイレギュラー運用状況") '呼び出し元シートの最終行、最終列を取得する endrow = ws.Cells(ws.Rows.Count, 6).End(xlUp).Row endcol = ws.Cells.Find(What:="変更フラグ", LookIn:=xlValues, LookAt:=xlWhole).Column - 2 If endrow < 4 Then Exit Sub ws.Range(ws.Cells(4, 1), ws.Cells(endrow, endcol)).ClearContents you_col = ws.Cells.Find(What:="曜日", LookIn:=xlValues, LookAt:=xlWhole).Column gak_col = ws.Cells.Find(What:="学年", LookIn:=xlValues, LookAt:=xlWhole).Column jig_col = ws.Cells.Find(What:="事業所", LookIn:=xlValues, LookAt:=xlWhole).Column 'bc_col = endcol - 1 'chg_col = endcol For i = 4 To endrow ws.Cells(i, you_col).Value = "=B" & i ws.Cells(i, gak_col).Value = "=VLOOKUP(F" & i & ",Sheet1!$A$2:$C$358,3,0)" ws.Cells(i, jig_col).Value = "=VLOOKUP(F" & i & ",Sheet1!$A$2:$C$358,2,0)" 'ws.Cells(i, bc_col).Value = "=IFERROR(MID(H" & i & ",LEN(H" & i & ")-1,1), "")" 'ws.Cells(i, chg_col).Value = 0 ws.Range("W" & i).Value = 0 Next '画面の更新を行う Application.ScreenUpdating = True End Sub

  • マクロ 行を切り取ってペーストでエラーになる

    J列に「0」と「#N/A」の行を切り取って集計対象外シートに貼り付けるといったコードです。 何故か途中でエラーになります。 どこが間違っておりますか? 宜しくお願いします。 Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row For i = 1 To LastRow If Cells(i, 10) = "0" Or Cells(i, 10) = "#N/A" Then Rows(i).Cut Sheets("集計対象外").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i

  • VBA 検索するSheetの位置の変更

    現在、グループの数だけユーザー名の合計数をSheet2に抽出するという 事をやっているのですが....... コードの方は下記になります Sub Sample3() Dim i As Long, j As Long, k As Long, lastRow As Long, lastCol As Long Dim wS2 As Worksheet, wS3 As Worksheet Set wS2 = Worksheets("Sheet1") Set wS3 = Worksheets("Sheet2") Application.ScreenUpdating = False If wS2.Range("Y1") = "" Then wS2.Range("Y1") = "ダミー" End If With Worksheets("Sheet1") If .Range("A4") = "" Then .Range("A4") = "ダミー" End If lastRow = .Cells(Rows.Count, "B").End(xlUp).Row Range(.Cells(5, "B"), .Cells(lastRow, "B")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("B:B"), _ wS2.Cells(7, (i - 2) * 8 + 3)) If WorksheetFunction.CountIf(wS2.Columns((i - 2) * 8 + 2), wS2.Cells(k, (i - 2) * 8 + 2)) > 1 Then wS2.Cells(k, (i - 2) * 8 + 2).Resize(, 2).Delete shift:=xlUp End If Next k Next i wS2.Range("B1").CurrentRegion.Borders.LineStyle = xlContinuous wS2.Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole .Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole wS3.Cells.Clear .AutoFilterMode = False End With Application.ScreenUpdating = True End Sub このコードで検索をかけるSheet1のセルBの文字をセルCに移動して検索かけたいという事なのですが、下記の用なコードでBをCに変更してみた結果エラーが発生してしまいます。 lastRow = .Cells(Rows.Count, "C").End(xlUp).Row Range(.Cells(5, "C"), .Cells(lastRow, "C")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("C:C"), _ どなたかご教授の方お願い致します。

専門家に質問してみよう