AIと戦って、あなたの人生のリスク診断 >>

あるエクセルシートを自動処理するVBAを作成しようとしています。

シートの内容は
A日付列 B得意先コード列 C金額列
20091001 000001 \1,000
20091001 000001 \1,500
20091002 000002 \800
20091002 000001 \1,200

といった感じです。
これを、指定した日付で、且つ得意先コード毎に集計したいと考えています。(上記の例だと、コード000001得意先は20091001で\2,500、20091002で\1,200といった具合です)

現在、日付毎で集計するところまでは作成できたのですが、ここから得意先別で集計するにはどのようにコーディングすればよいでしょうか。

日付毎の集計は以下のようにしています。
cnt = 2
Total = 0
Do Until False
'行が底に達したらループを終了します
If Range("D" & cnt).Value = "" Then
Exit Do
End If
    'D列の日付と指定の日付が合致したら
If yearmonthday = Range("D" & cnt).Value Then
'L列の金額を取得しカウント
Total = Total + CDbl(Range("T" & cnt))
'次の行を検索するための行数カウント
cnt = cnt + 1
Else
cnt = cnt + 1
End If
Loop
ご存知の方、どうぞ教えてください。

このQ&Aに関連する最新のQ&A

A 回答 (2件)

参考例として。



Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …
【重複しないリストを生成する】
-【2つの条件で合計する】

の様な方法もあります。
    • good
    • 1

こんにちは。



 今のプログラムでは、「Total」という1つの変数しかないので、「指定した日付で、且つ得意先コード毎に集計」した値を格納できません。得意先分の配列を定義してそこに格納しなければならないのですが、得意先が100だからといって、Total(100)という1次元配列にしてしまうと、今度は何番目の配列にどの会社のデータを格納したかわからなくなってしまいます。(得意先コードが連番であればそれでもかまいませんが。)Total(2,100)と2次元配列にし、Total(1,x)に得意先コード、Total(2,x)に合計金額を格納すればよいと思います。

では。
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcel VBAでグループ毎に集計する方法

ExcelのVBAについて教えてください。

A列 B列
OK 9/21
OK 9/21
NG 9/20
OK 9/20
NG 9/21

とセルに入力されていたときに、各日付ごとにOK、NGの発生回数を出す
場合はどのようにすれば良いのでしょうか?
9/20 OK:1個、NG:1個
9/21 OK:2個、NG:1個

大量のデータを扱うため、できるだけ早い処理方法で実現できる方法を希望しています。

Aベストアンサー

日付順にソートして上から見ていくのが普通の手法ですが
できるだけ早い処理方法で、ということなので、少し捻ってみました。

・データ数 : 6万行
・日付 : 2009/1/1 ~ 2009/12/31 の間でランダム
の場合、私の環境だと0.2秒ほどで結果が出ます。

'=====↓ ココカラ ↓================================================
Sub Sample()
 Dim orgAry  As Variant
 Dim sumAry() As Long
 Dim dayCnt  As Long
 Dim rtnAry() As Long
 Dim i    As Long
 Dim j    As Long
 
 'とりあえず1982年から2036年まで対応
 ReDim sumAry(30000 To 50000, 0 To 2)
 
 'アクティブシートの、A:B列のデータを読み込む
 With ActiveSheet
  orgAry = Intersect(.UsedRange, .Range("A:B")).Value
 End With
 
 For i = 1 To UBound(orgAry, 1)
  If sumAry(orgAry(i, 2), 0) = 0 Then
   sumAry(orgAry(i, 2), 0) = 1
   dayCnt = dayCnt + 1
  End If
  Select Case orgAry(i, 1)
   Case "OK": sumAry(orgAry(i, 2), 1) = sumAry(orgAry(i, 2), 1) + 1
   Case "NG": sumAry(orgAry(i, 2), 2) = sumAry(orgAry(i, 2), 2) + 1
  End Select
 Next i
 
 ReDim rtnAry(1 To dayCnt, 1 To 3)
 j = 1
 For i = LBound(sumAry, 1) To UBound(sumAry, 1)
  If sumAry(i, 0) = 1 Then
   rtnAry(j, 1) = i
   rtnAry(j, 2) = sumAry(i, 1)
   rtnAry(j, 3) = sumAry(i, 2)
   j = j + 1
  End If
 Next i
 
 'アクティブシートのC1セル以下に結果を書き出す
 With ActiveSheet
  .Range("C1").Resize(dayCnt, 3).Value = rtnAry
  .Range("C1").Resize(dayCnt, 1).NumberFormatLocal = "yyyy/mm/dd"
 End With
 
End Sub
'=====↑ ココマデ ↑================================================

以上ご参考まで。

日付順にソートして上から見ていくのが普通の手法ですが
できるだけ早い処理方法で、ということなので、少し捻ってみました。

・データ数 : 6万行
・日付 : 2009/1/1 ~ 2009/12/31 の間でランダム
の場合、私の環境だと0.2秒ほどで結果が出ます。

'=====↓ ココカラ ↓================================================
Sub Sample()
 Dim orgAry  As Variant
 Dim sumAry() As Long
 Dim dayCnt  As Long
 Dim rtnAry() As Long
 Dim i    As Long
 Dim j    As Long...続きを読む

Qexcel vba 複数項目の集計

EXCEL2003 VBAにてマクロを作成しているのですが、作成日程が迫っているにも関わらず、
すぐ行き詰ってしまいます。どうかご指導お願い致します。

以下のような事をしたいのですが、できる限り高速で最も効率の良い方法を教えていただきたいと
思っております。よろしくお願い致します。

あるSheetに以下のようにデータが登録されていて、
A       B        C
りんご    赤       200
なし     黄色      100
りんご    緑       100
メロン    緑       10
なし     黄色      200
りんご    緑       500

これを集計すると、
りんご  赤  200
りんご  緑  600
なし   黄色 300
メロン  緑  10
と、結果を返したいと考えています。

数字を合計するのはA列とB列がともに一致した時のみです。

最初は単純に何回もForNextで処理しようと思ったのですが、行数が
多くなると繰り返し回数も多くなり、時間もかかってしまうので、
別の方法でもっといい方法があればと思い、質問させていただきました。
宜しくお願いします。

EXCEL2003 VBAにてマクロを作成しているのですが、作成日程が迫っているにも関わらず、
すぐ行き詰ってしまいます。どうかご指導お願い致します。

以下のような事をしたいのですが、できる限り高速で最も効率の良い方法を教えていただきたいと
思っております。よろしくお願い致します。

あるSheetに以下のようにデータが登録されていて、
A       B        C
りんご    赤       200
なし     黄色      100
りんご    緑       100
メロン    緑   ...続きを読む

Aベストアンサー

自前で検索するのをやめて Scripting.Dictionaryオブジェクトに任せるなら

Sub Test()
  Dim dicName As New Dictionary
  Dim r As Range
  Dim dicCor As Dictionary
  Dim sName, sColor, obj
  Dim nn As Integer

  ' データの集計
  For Each r In Range("A2", Range("A65536").End(xlUp))
    ' りんご、なし、メロンなどを取得
    sName = r.Value
    ' 色を取得
    sColor = r.Offset(, 1).Value
    ' 値段を取得
    nn = r.Offset(, 2).Value
    ' dicNameに登録済みか検査
    If dicName.Exists(sName) = False Then
      ' 未登録なら 色、値段を登録
      Set dicCor = New Dictionary
      dicCor.Add sColor, nn
      dicName.Add sName, dicCor
    Else
      ' 登録済みの場合 色情報を検査
      Set dicCor = dicName(sName)
      If dicCor.Exists(sColor) = False Then
        ' 色情報が未登録なら 新規登録
        dicCor.Add sColor, nn
      Else
        ' 色情報があるなら 値段を更新
        nn = dicCor(sColor) + nn
        dicCor(sColor) = nn
      End If
      ' 色情報を更新
      Set dicName(sName) = dicCor
    End If
  Next

  ' 出来上がったデータを表示
  For Each sName In dicName
    Set dicCor = dicName(sName)
    For Each sColor In dicCor
      n = dicCor(sColor)
      ' セルに転記するなら Rangeなどに置き換えましょう
      Debug.Print sName, sColor, nn
    Next
  Next
End Sub
といった具合で ・・・

自前で検索するのをやめて Scripting.Dictionaryオブジェクトに任せるなら

Sub Test()
  Dim dicName As New Dictionary
  Dim r As Range
  Dim dicCor As Dictionary
  Dim sName, sColor, obj
  Dim nn As Integer

  ' データの集計
  For Each r In Range("A2", Range("A65536").End(xlUp))
    ' りんご、なし、メロンなどを取得
    sName = r.Value
    ' 色を取得
    sColor = r.Offset(, 1).Value
    ' 値段を取得
    nn = r.Offset(, 2).Value
    ...続きを読む

Qエクセルの表の集計をVBAでやりたいのです。

エクセルのsheet1にこのような表があります。
A B C D E
1 名称 金額
2 あああああ 10000
3 あああああ 12000
4 あああああ 9000
5 いいいいい 9500
6 いいいいい 11000
7 ううううう 15000
8 えええええ 12000
9 おおおおお 10000
10 おおおおお 14000
11 かかかかか 13000
12 ききききき 800

以下多数

この表で、それぞれ同じ名称の個数と合計金額を求めたいのです。
たとえば「ああああ」なら個数 3、合計 31000 と、D4とE4に、
「いいいい」なら個数 2、合計 25000 と、D6とE6に入れたいのです。
実際の表はデータ件数が1万件を越えますのでいちいち手で入れるわけにはいきません。
VBAでやるにはどう記述したらいいでしょうか?
どうかお助けください。よろしくお願いします。

エクセルのsheet1にこのような表があります。
A B C D E
1 名称 金額
2 あああああ 10000
3 あああああ 12000
4 あああああ 9000
5 いいいいい 9500
6 いいいいい 11000
7 ううううう 15000
8 えええええ 12000
9 おおおおお 10000
10 おおおおお 14000
11 かかかかか 13000
12 ききききき 800

以下多数

この表で、それぞれ同じ名称の個数と合計金額を求めたいのです。
たとえば「ああ...続きを読む

Aベストアンサー

A列は名称でB列は金額でよろしいんですよねというか
その前提で書きましたが。
デバッグはしてません。またオーバーフロー等あると思うのでそのあたりはご自分で。

Sub 集計()
Dim i, MyTotal As Double, MyCount As Double
MyTotal = Sheets(1).Range("A2")(1, 2)
MyCount = 1
For i = 2 To 65535
If Sheets(1).Range("A2")(i) = "" Then Exit For
If Sheets(1).Range("A2")(i) = Sheets(1).Range("A2")(i - 1) Then
MyTotal = MyTotal + Sheets(1).Range("A2")(i, 2)
MyCount = MyCount + 1
Else
Sheets(1).Range("A2")(i - 1, 4).Formula = MyCount
Sheets(1).Range("A2")(i - 1, 5).Formula = MyTotal
MyTotal = Sheets(1).Range("A2")(i, 2)
MyCount = 1
End If
Next i
Sheets(1).Range("A2")(i - 1, 4).Formula = MyCount
Sheets(1).Range("A2")(i - 1, 5).Formula = MyTotal
End Sub

A列は名称でB列は金額でよろしいんですよねというか
その前提で書きましたが。
デバッグはしてません。またオーバーフロー等あると思うのでそのあたりはご自分で。

Sub 集計()
Dim i, MyTotal As Double, MyCount As Double
MyTotal = Sheets(1).Range("A2")(1, 2)
MyCount = 1
For i = 2 To 65535
If Sheets(1).Range("A2")(i) = "" Then Exit For
If Sheets(1).Range("A2")(i) = Sheets(1).Range("A2")(i - 1) Then
MyTotal = MyTotal + Sheets(1).Ran...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QVBA 別シートの同じ日付の欄に値を貼付け

日次で届く売り上げデータを集計した後、別シートの記入用フォーマットにコピーしたいのですが、「Sheet1」にあるデータを、「Sheet2」の対応する日付の欄に<値を貼付け>するVBAを教えていただけないでしょうか。

※画像の参照をお願いします。

例えば「Sheet1」にある6/6のデータ(B6:C25)を、マクロで「Sheet2」の6/6の欄に
<値を貼付け>したいです。
「Sheet1」には、1日分のデータ欄のみがあります。
「Sheet2」には、あらかじめ1年分の記入欄を用意しています。

集計をしない日もあるため、記入用フォーマット(Sheet2)の左端から詰めていくという方法は使えませんでした。
集計をしない日は空欄のままにしたいです。

それと欲を張ってすみませんが、以下の場合は動作を中止して、警告を出すようにしたいです。
・記入用フォーマットに、対応する日付が無かった場合
・記入用フォーマットの対応する日付の欄に、すでに何かが記入されている場合

説明が分かりづらかったらすみません。

よろしくお願いします。

日次で届く売り上げデータを集計した後、別シートの記入用フォーマットにコピーしたいのですが、「Sheet1」にあるデータを、「Sheet2」の対応する日付の欄に<値を貼付け>するVBAを教えていただけないでしょうか。

※画像の参照をお願いします。

例えば「Sheet1」にある6/6のデータ(B6:C25)を、マクロで「Sheet2」の6/6の欄に
<値を貼付け>したいです。
「Sheet1」には、1日分のデータ欄のみがあります。
「Sheet2」には、あらかじめ1年分の記入欄を用意しています。

集計をしない日もあるため、...続きを読む

Aベストアンサー

例外は無いとして以下の様なものでいかがでしょうか?
-------------------------------------------------------------
Sub 集計()

Dim 日付 As Date
Dim 列番号 As Long

日付 = Sheets("Sheet1").Cells(4, 3).Value
Sheets("Sheet2").Select
For 列番号 = 6 To Cells(4, Columns.Count).End(xlToLeft).Column Step 2
If Cells(4, 列番号).Value = 日付 Then Exit For
Next
If Cells(4, 列番号).Value <> 日付 Then
MsgBox ("対象の日付が見つかりませんでした。")
Exit Sub
End If
If Cells(Rows.Count, 列番号).End(xlUp).Row <> 5 Then
Cells(Cells(Rows.Count, 列番号).End(xlUp).Row, 列番号).Select
MsgBox ("データが既に書き込まれています。")
Exit Sub
End If
Sheets("Sheet1").Select
Range(Cells(6, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 3)).Copy
Sheets("Sheet2").Select
Cells(6, 列番号).Select
Selection.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False

End Sub
-------------------------------------------------------------

例外は無いとして以下の様なものでいかがでしょうか?
-------------------------------------------------------------
Sub 集計()

Dim 日付 As Date
Dim 列番号 As Long

日付 = Sheets("Sheet1").Cells(4, 3).Value
Sheets("Sheet2").Select
For 列番号 = 6 To Cells(4, Columns.Count).End(xlToLeft).Column Step 2
If Cells(4, 列番号).Value = 日付 Then Exit For
Next
If Cells(4, 列番号).Value <> 日付 Then
MsgBox ("対象の日付が見つかりませんでした。")
Exit Sub
End If
...続きを読む

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列> <B列> <C列>
7/1 りんご 100円
7/2 ぶどう 200円
7/2 すいか 300円
7/3 みかん 100円

このような表があって、100円を含む行をそのままの形で、
別のセル(同じシート内)に抜き出したいのですが。

7/1 りんご 100円
7/3 みかん 100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は500行までとしていますが、必要に応じて変更して下さい

QExcelで日別に入力されたデータを月別に集計するにはどうしたらいいのでしょうか。

Excelで月別の集計をしたいのですが
例えば
  日付    数量
10月25日  200
10月27日  150
10月30日  120
11月 1日  200
11月 3日  150
のように、日付が飛び飛びで連続していなくい日々の数量を、上の行から順番に入力していった場合に(月が替わる行が決まっていない)月別の集計を取る方法はないでしょうか。


 

Aベストアンサー

どのように集計する月を指定するのかが書かれていませんが、例えば11月分の合計を出したいなら

1)11月までの合計から10月までの合計を引く方法
 =SUMIF(A:A,"<=11/30",B:B)-SUMIF(A:A,"<=10/31",B:B)

2)月が「11」のB列を合計する方法
 =SUMPRODUCT((MONTH(A2:A100)=11)*(B2:B100))

なども考えられます。

でもエクセルなら一番オーソドックスな方法はピボットテーブルでしょう。C列に
 =TEXT(A1,"YYYY/MM")
で「2008/11」のような文字列を生成しておいてピボットテーブルで集計すれば、シート上にある全ての月の合計が一発で求められます。
ピボットテーブルの使い方はGoogleなどで検索したらたくさん見つかります
http://www.viplt.ne.jp/tomy/pibot.html

Q複数条件が一致で別シートに転記【エクセルVBA】

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
------------------------------------------------
2 たけだ  配達  6/20(月) 13:00  2個
3 みうら  配達  6/18(土) 14:00  4個
4 らもす  郵送  6/20(月)  ―   5個
5 いはら  配達  6/20(月) 14:30  8個
6 かつや  配達  6/20(月) 15:00  6個
7 みうら  郵送  6/20(月)  ―   4個

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00
3  12:30
4  13:00
5  13:30
6  14:30
7  15:00
8  15:30
9  16:00

マクロを実行すると・・・
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00 
3  12:30
4  13:00    たけだ   2個
5  13:30
6  14:00    みうら   4個
6  14:30   いはら   8個
7  15:00   かつや   6個
8  15:30
9  16:00

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
-...続きを読む

Aベストアンサー

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表は、VBAを勉強してそれを使うべきと思う(既に回答も出ているようだ)
関数で抜き出し問題や表の組み換えは、VBAで無いと、天下りの長い式をコピペで使うだけになる。
ーー
私が紹介している「imogasi方式」では、Sheet2に時刻の所定の行に出す問題なので複雑になりすぎる。
ーー
VBAでやってみる。
例データ
しめい対応配達日時間個数
たけだ配達6月20日13:002個
みうら配達6月18日14:004個
らもす郵送6月20日ーー5個
いはら配達6月20日14:308個
かつや配達6月20日15:006個
みうら郵送6月20日ーー4個
(注意)
「ーー」セルは空白とする
「月日」列は、エクセルの年月日を入れておくこと(日付シリアル値(わかりますか)) 文字列では不可
6/20(月) の様な表示は、表示形式の設定でやること(エクセルの常識)  m/d(aaa)
時間の列も時刻シリアル値で入れてあるとする。文字列では不可
ーー
コード
標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "B") = "配達" And sh1.Cells(i, "C") = sh2.Range("B1") And _
sh1.Cells(i, "D") <> "" Then
t = sh1.Cells(i, "D")
'---Sheet2で時刻行を探す
For r = 2 To 30
If sh1.Cells(i, "D") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "A")
Sheet2.Cells(r, "C") = sh1.Cells(i, "E")
End If
Next i
End Sub
ーー
実行結果
Sheet2
配達6月20日
12:00
12:30
13:00たけだ2個
13:30
14:00
14:30いはら8個
15:00かつや6個
15:30
16:00
・・・・・・

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表...続きを読む

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

QVBAで条件が一致する行のデータを別シートに抽出

"Sheet1"のA列に区分(文字列)、B列~D列に分析数値があり
A列の文字が条件に一致した行のデータを"Sheet2"にコピー、
元の"Sheet1"のデータは行ごと削除といった形で考えているのですが、どうも上手くいきません。

Dim Keywrd As String
???
With Worksheets("Sheet1").Columns("A:A")
Set Keywrd = .Find("キーワード", LookIn:=xlValues)
???
End With
Set Keywrd = Nothing
TargetCell.EntireRow.Select
Selection.Delete Shift:=xlUp
End Sub


???部分の変数宣言と処理内容をどうすれば良いか、ご教授願えますでしょうか。

Aベストアンサー

こんばんは。

#1の回答者です。一度きりなら、こんな風に直してみたらよいと思います。質問のコードは、変数の流れがおかしくなっているようです。

Sub Macro1()
  Dim Keywrd As String
  Dim TargetCell As Range
  Keywrd = InputBox("キーワードを入れてください", "キーワード入力")
  If Keywrd = "" Then Exit Sub
  With Worksheets("Sheet1").Columns("A:A")
    Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
    If TargetCell Is Nothing Then
      MsgBox Keywrd & " は見つかりません。"
      Exit Sub
    End If
  End With
  'Keywrd = "" ''不要
  TargetCell.EntireRow.Copy Worksheets("Sheet2").Range("A1")
  TargetCell.Delete Shift:=xlUp

End Sub

--------------------------------------
#1 のコードを考え直し修正しました。
私のコードは、必ず、検索値に対して複数、該当するものがあるという条件になっています。

---------------------------------------------
Sub TestFind2()
 Dim myKeyWord As String
 Dim FirstAdd As String
 Dim c As Range
 Dim ur As Range
 myKeyWord = Application.InputBox("検索文字を入れてください", "検索+移動", Type:=2)
 If myKeyWord = "" Or myKeyWord = "False" Then Exit Sub

 With Worksheets("Sheet1").Columns(1)
 .Cells(1).Select
 Set c = .Find( _
      What:=myKeyWord, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      MatchCase:=False, _
      MatchByte:=True)

  If Not c Is Nothing Then
     Set ur = c.EntireRow
     FirstAdd = c.Address
    Do
      Set ur = Union(c.EntireRow, ur)
      Set c = .FindNext(c)
    Loop Until (c Is Nothing) Or (FirstAdd = c.Address)
   End If
   ur.Copy Worksheets("Sheet2").Range("A1")
   ur.Delete Shift:=xlShiftUp
End With
   Set ur = Nothing
End Sub


 

こんばんは。

#1の回答者です。一度きりなら、こんな風に直してみたらよいと思います。質問のコードは、変数の流れがおかしくなっているようです。

Sub Macro1()
  Dim Keywrd As String
  Dim TargetCell As Range
  Keywrd = InputBox("キーワードを入れてください", "キーワード入力")
  If Keywrd = "" Then Exit Sub
  With Worksheets("Sheet1").Columns("A:A")
    Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
    If TargetCell Is Nothing Then
...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング