エクセルVBA 請求データ一覧からの複数の処理
- VBA初心者でも簡単にできるエクセル請求データ一覧の処理方法を解説します。
- 費目コード・費目名・金額を抽出したデータをまとめ、課税と非課税の合計金額を求める方法を説明します。
- エクセルVBAを使って、請求データ一覧から複数の費目の合計金額を計算する方法を解説します。複雑な処理も簡単に行えます。
- ベストアンサー
エクセルVBA 請求データ一覧からの複数の処理
VBA初心者です。 費目コード・費目名・金額を抽出したデータがあります。 例えば、横一列に A2：費目コード「A01」 B2：費目名「XXXX」 C2：金額「10,000」 D2：費目コード「Z05」 E2：費目名「BBBB」 F2：金額「5,000」 ・ ・ と1行に5～10の費目が抽出されています。 （1行目はタイトル行） 行毎が1件の請求となっていますが、 費目コード〇〇と▲▲は課税(非課税)対象として認識し、 その金額を合計したものを、worksheet2の特定のセルに 記載することは可能でしょうか。 説明が上手く出来ず申し訳ありません。 宜しくお願い致します。
- lunar-eclipce
- お礼率67% (50/74)
- Excel（エクセル）
- 回答数9
- ありがとう数5
- みんなの回答 （9）
- 専門家の回答
質問者が選んだベストアンサー
No.8の一部訂正です。 問題はないとも思いますが念のために > For k = 2 To LastRow > If Ws1.Cells(i, j).Value = List1.Cells(k, 1).Value Then > mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value > Exit For > End If > If Ws1.Cells(i, j).Value = List2.Cells(k, 1).Value Then > mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value > Exit For > End If > Next の部分を以下のように変更してください。 For k = 2 To LastRow If List1.Count >= k Then If Ws1.Cells(i, j).Value = List1.Cells(k, 1).Value Then mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If End If If List2.Count >= k Then If Ws1.Cells(i, j).Value = List2.Cells(k, 1).Value Then mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If End If Next ついでですので、List1,List2を他の方法でやるやり方も記載しておきます。 Sub Test4() Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet Dim mTotal1 As Long, mTotal2 As Long Dim LastRow As Long Dim List1 As Variant, List2 As Variant Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") List1 = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)).Value List2 = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)).Value If UBound(List1) >= UBound(List2) Then LastRow = UBound(List1) Else LastRow = UBound(List2) End If For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row mTotal1 = 0 mTotal2 = 0 For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 For k = 2 To LastRow If UBound(List1) >= k Then If Ws1.Cells(i, j).Value = List1(k, 1) Then mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If End If If UBound(List2) >= k Then If Ws1.Cells(i, j).Value = List2(k, 1) Then mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If End If Next Next Ws2.Cells(i, "J").Value = mTotal1 Ws2.Cells(i, "K").Value = mTotal2 Next Set Ws1 = Nothing Set Ws2 = Nothing End Sub
その他の回答 (8)
- kkkkkm
- ベストアンサー率65% (1618/2457)
No.7の追加です。 No.7ではリストのセル指定が何度か出てくるので それぞれ List1 List2 として利用できるようにしました。 Sub Test3() Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet Dim mTotal1 As Long, mTotal2 As Long Dim LastRow As Long Dim List1 As Range, List2 As Range Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") Set List1 = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)) Set List2 = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)) If List1.Count >= List2.Count Then LastRow = List1.Count Else LastRow = List2.Count End If For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row mTotal1 = 0 mTotal2 = 0 For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 For k = 2 To LastRow If Ws1.Cells(i, j).Value = List1.Cells(k, 1).Value Then mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If If Ws1.Cells(i, j).Value = List2.Cells(k, 1).Value Then mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If Next Next Ws2.Cells(i, "J").Value = mTotal1 Ws2.Cells(i, "K").Value = mTotal2 Next Set List1 = Nothing Set List2 = Nothing Set Ws1 = Nothing Set Ws2 = Nothing End Sub
- kkkkkm
- ベストアンサー率65% (1618/2457)
> 補足を入れさせて頂きました。 他の方への補足を参照させるのはいかがなものかと思いますが…。 コードリスト１及び２の場所が不明なので Sheet2のA1からコードリスト１ Sheet2のB1からコードリスト２ として 質問では3列一組だったのに補足では2列一組になっているので2列一組と考えます。 Sub Test2() Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet Dim mTotal1 As Long, mTotal2 As Long Dim LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") If Ws2.Cells(Rows.Count, "A").End(xlUp).Row >= Ws2.Cells(Rows.Count, "B").End(xlUp).Row Then LastRow = Ws2.Cells(Rows.Count, "A").End(xlUp).Row Else LastRow = Ws2.Cells(Rows.Count, "B").End(xlUp).Row End If For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row mTotal1 = 0 mTotal2 = 0 For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 For k = 2 To LastRow If Ws1.Cells(i, j).Value = Ws2.Cells(k, "A").Value Then mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If If Ws1.Cells(i, j).Value = Ws2.Cells(k, "B").Value Then mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value Exit For End If Next Next Ws2.Cells(i, "J").Value = mTotal1 Ws2.Cells(i, "K").Value = mTotal2 Next Set Ws1 = Nothing Set Ws2 = Nothing End Sub
- imogasi
- ベストアンサー率27% (4737/17068)
既にVBAの回答も出ていますが、 ５列で１レコード（行）（請求の中の明細のデータ単位）らしいから、 まず分解して下記のようにSheet2に分解後のデータを作り、その後の処理を考えたらどうか。VBAでか、関数でか。金額合計なら、SUMIF（SUMIFS）でもできそう。 ーーー 質問説明の書き方も下記のようにしたらどうか。回答よりも、この点を言いたい。 ＜ーーー ＞説明が上手く出来ず申し訳ありません OKWAVE画面の、回答のこの部分をコピし、自分のシートに貼りつける。その後２手間かけるが、データー区切り位置で、自分のシートに下記データが再現できるだろう。複雑なものだと列ずれを起こすかもしれないが。 データ例 Sheet1 A1:I4 費目コード 費目名 金額 費目コード 費目名 金額 費目コード 費目名 金額 A01 aaa 10000 Z05 bbb 5000 B02 ccc 8000 B01 ddd 10000 C01 eee 5000 C01 eee 50000 Z05 fff 7000 B02 ggg 20000 標準モジュールに Sub ttest01() Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") K = 2 'アウトプット用 処理スタート行 Sheet2の第2行 １行目は見出し。本件では略。 lr = sh1.Range("A100000").End(xlUp).Row 'MsgBox lr For i = 2 To lr '2行目から １行目は見出し rc = sh1.Cells(i, 1000).End(xlToLeft).Column MsgBox rc For j = 1 To rc Step 3 '３列ごと１まとまりだから sh2.Cells(K, "A") = sh1.Cells(i, j) sh2.Cells(K, "B") = sh1.Cells(i, j + 1) sh2.Cells(K, "c") = sh1.Cells(i, j + 2) K = K + 1 '次回用に次行を指しておく Next j Next i End Sub ーーー 実行すると、 Sheet2のA2:C９ A01 aaa 10000 Z05 bbb 5000 B02 ccc 8000 B01 ddd 10000 C01 eee 5000 C01 eee 50000 Z05 fff 7000 B02 ggg 20000 その後の処理は略。簡単なので。
補足
早々にご回答頂きまして有難うございます。 質問の内容が不明瞭で申し訳ありません。 ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。 具体例をもう少しわかりやすく記載してみました。 2行目から実際の請求データになります。 ①各行のコードがコードリスト１及び２に記載がある か参照する ②リスト１に記載のコード／リスト２に記載のコード でそれぞれ分けて金額を合計する ③リスト１の合計金額 worksheet2の 「J2,J3・・・」のセルにそれぞれ 入力する リスト２の合計金額 worksheet2の「K2,K3・・・」のセルにそれぞれ 入力する 下記の例ですと、 2行目・・・コードA01,Z05,B02はリスト1に該当 A01,Z05,B02の合計金額113000を worksheet2の「J2」のセルに入力 3行目・・・コードP01,W01はリスト１に該当 P01,W01の合計金額67000を worksheet2の「J3」のセルに入力 X01,Z01はリスト２に該当 X01,Z01の合計金額22200を worksheet2の「K3」のセルに入力 A B C D E F G H 1 コード 金額 コード 金額 コード 金額 コード 金額 2 A01 100000 Z05 5000 B02 8000 3 P01 50000 W01 17000 X01 20000 Z01 2200 コードリスト1 A01 A02 B01 B02 C01 C02 ・ ・ P01 W01 Z05 コードリスト2 X01 Y01 Z01 この操作がVBAで可能でしょうか・・・。 ご教示頂けると有難いです。
- kkkkkm
- ベストアンサー率65% (1618/2457)
Sheet2のG2から下に対象費目コード一覧ある場合です。 Sub Test2() Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet Dim mTotal As Currency Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row mTotal = 0 For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 3 For k = 2 To Ws2.Cells(Rows.Count, "G").End(xlUp).Row If Ws1.Cells(i, j).Value = Ws2.Cells(k, "G").Value Then mTotal = mTotal + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If Next Next Ws2.Cells(i, "A").Value = mTotal Next Set Ws1 = Nothing Set Ws2 = Nothing End Sub
補足
早々にご回答頂きまして有難うございます。 質問の内容が不明瞭で申し訳ありません。 ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。 補足を入れさせて頂きました。 ご参照頂けると有難いです。
- kkkkkm
- ベストアンサー率65% (1618/2457)
合計したい費目コードや記載したいSheet2の場所が分からないので 行ごとに費目コード「A01」と「Z05」の合計をSheet2のA列同一行に記載する場合です。 Sub Test() Dim i As Long, j As Long Dim Ws1 As Worksheet, Ws2 As Worksheet Dim mTotal As Currency Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row mTotal = 0 For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 3 If Ws1.Cells(i, j).Value = "A01" Or Ws1.Cells(i, j).Value = "Z05" Then mTotal = mTotal + Ws1.Cells(i, j).Offset(0, 2).Value End If Next Ws2.Cells(i, "A").Value = mTotal Next Set Ws1 = Nothing Set Ws2 = Nothing End Sub
補足
早々にご回答頂きまして有難うございます。 質問の内容が不明瞭で申し訳ありません。 ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。 補足を入れさせて頂きました。 ご参照頂けると有難いです。
- kon555
- ベストアンサー率52% (1750/3357)
可能不可能で言えば可能です。ただし『費目コード〇〇と▲▲』のように条件が明確である必要があります。 その条件がクリアされているなら、例えば別のシートなどで課税対象のリスト、非課税対象のリストを作成しておいて、データを上から参照していき、リストに従ってそれぞれの対象の合計を算出する形がとれます（あくまで一例です）。 コード的にはifとforの組み合わせになるでしょう。 https://www.sejuku.net/blog/30059 https://valmore.work/excel-vba-for/ またVBAでなくとも、対象リストがあれば関数だけでも対応可能です。方法は色々あるでしょうが、SUMIFSがシンプルで分かり易いと思います。 https://blog02.aqua-school.com/2019/07/26/excel-35/
補足
早々にご回答頂きまして有難うございます。 質問の内容が不明瞭で申し訳ありません。 ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。 補足を入れさせて頂きました。 ご参照頂けると有難いです。
- f272
- ベストアンサー率46% (8010/17118)
あなたが手作業でやれるのであれば，それはVBAを使ってもできます。 手作業でやるとすればどうするのかを書いてもらえば，親切な人がコードを作ってくれるかもしれません。
お礼
早々にご回答頂きまして有難うございました。
- m5048172715
- ベストアンサー率16% (860/5258)
できる。私はエクセルの関数をよく知らないけど、VBAなら書けたので、VBAでやってた。 まず任意の（ブック、シート、）セルを読み書きできる関数を作ればこっちのもので、あとは文字でも数字でも（単純な図形でも）VBAで処理できる。エクセルの見にくい1行の式より、エディタで見やすいコードのVBAの方がやりやすい。 そのときは、課税シートというのを用意して、そこに課税非課税の一覧を作り、VBAで処理するとき随時課税シートを参照することになるだろう。VBAのコードに課税項目を盛り込むと、オペレーターが修正や追加できないっぽい。
お礼
早々にご回答頂きまして有難うございました。
関連するQ&A
- エクセルVBA 請求データ一覧からの複数の処理
先日 1度質問をさせて頂いたものです。 作業内容が追加で必要になり試行錯誤でやっていたのですが躓いてしまいまして、 再度の質問で申し訳ありませんが、ご教示頂けないでしょうか。 抽出したデータは１行「AO」まで入力がされています。 実際に請求書に関係するものは「J」以降になり、 「J」以降は3列1組のデータとなります。 これを行単位で(行単位でなくても構いません)、 記載のある行まで繰り返し同じ処理を行いたいのですが、 可能でしょうか。 <例> ① Worksheet1の2行目を選択 ② Worksheet2の A列 List1 B列 List2 C列 List3 Ｄ列 List4 の数値を参照 ③ List1に記載のコードに該当してれば そのコードの金額を合計し、 Worksheet3"請求書ひな形"のセル「J２」に入力 List2に記載のコードに該当していれば、 そのコードの金額を合計し、 Worksheet3"請求書ひな形"のセル「K2」に入力 List３に記載のコードに該当していれば、 そのコードの金額を合計し、 Worksheet3"請求書ひな形"のセル「L2」に入力 List４に記載のコードに該当していれば、 そのコードの金額を合計し、 Worksheet3"請求書ひな形"のセル「N2」に入力 セル「AN」の値を Worksheet3"請求書ひな形"のセル「M2」に転記 セル「AO」の値を Worksheet3"請求書ひな形"のセル「O2」に転記 <Workseet1> ・・・・・J K L M N O ・・・・・・AO ・・・・コード 費目名 金額 コード 費目名 金額 ２ A01 ○○ 100000 Z05 xxx 5000 ・ ・ ・ <Worksheet2> A B C D A01 Ｃ01 P01 D01 A02 Ｃ02 P05 D11 A03 E01 Q10 D12 B01 F10 Q20 D20 B02 F20 R01 D30 ・ ・ ・ どうぞ宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- VBA 請求データ一覧からの複数の処理
先週 kkkkkmさんに質問をさせて頂きまして、 いろいろご指導を頂いたものです。 続編の様な形になってしまいますが、 抽出するデータの環境設定を変更致しました。 ご質問させて頂く内容は前回とほとんど変更がないのですが、 あらためて下記に記載させて頂きます。 <Worksheet1のデータ> Ｊ列～AM列までが課税金額 「J,K,L」「M,N,O」・・・「AK,AL,AM」と3列1組（コード・費目・金額） 1組の行もあれば、複数組の行もあり。 AN列～BB列までが非課税金額 課税金額と同じく3列1組 1組の行もあれば、複数組の行もあり。 「BC」=消費税、「ＢＤ」=合計金額 ※AN列の前に不規則な空白セルあり BC列の前に不規則な空白セルあり 文章で上手く説明出来ているか自信がありませんので、 エクスポートした元データ Worksheet1と、 vbaを用いて作成した Worksheet3 をご参考に添付致します。 Worksheet1の2行目がWorksheet3の2行目に対応しています。 3行目、4行目も同様です。 不規則な空白が原因でしょうか・・・。 M列、O列は問題ないのですが、 金額が合わなかったり、N列に金額を引いてこないのです。 実行しているコードは下記になります。 Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet Dim mTotal(4) As Long Dim LastRow As Long Dim List(4) As Variant Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") Set Ws3 = Sheets("請求書ひな形") List(1) = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)).Value List(2) = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)).Value List(3) = Ws2.Range(Ws2.Cells(1, "C"), Ws2.Cells(Rows.Count, "C").End(xlUp)).Value List(4) = Ws2.Range(Ws2.Cells(1, "D"), Ws2.Cells(Rows.Count, "D").End(xlUp)).Value LastRow = UBound(List(1)) For i = 2 To 4 If LastRow < UBound(List(i)) Then LastRow = UBound(List(i)) End If Next For i = 2 To Ws1.Cells(Rows.Count, "J").End(xlUp).Row mTotal(1) = 0 mTotal(2) = 0 mTotal(3) = 0 mTotal(4) = 0 For j = Columns("J").Column To Columns("BB").Column Step 3 For k = 2 To LastRow If UBound(List(1)) >= k Then If Ws1.Cells(i, j).Value = List(1)(k, 1) Then mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(2)) >= k Then If Ws1.Cells(i, j).Value = List(2)(k, 1) Then mTotal(2) = mTotal(2) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(3)) >= k Then If Ws1.Cells(i, j).Value = List(3)(k, 1) Then mTotal(3) = mTotal(3) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(4)) >= k Then If Ws1.Cells(i, j).Value = List(4)(k, 1) Then mTotal(4) = mTotal(4) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If Next Next Ws3.Cells(i, "J").Value = mTotal(1) Ws3.Cells(i, "K").Value = mTotal(2) Ws3.Cells(i, "L").Value = mTotal(3) Ws3.Cells(i, "N").Value = mTotal(4) Ws3.Cells(i, "M").Value = Ws1.Cells(i, "BC").Value Ws3.Cells(i, "O").Value = Ws1.Cells(i, "BD").Value Next Set Ws1 = Nothing Set Ws2 = Nothing Set Ws3 = Nothing End Sub 本当に何度も申し訳ございません。 お時間がある時に見て頂けると有り難いです。 どうぞ宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- エクセルVBAを教えてください。
エクセルVBA初心者です。 仕事の都合でどうしても下記マクロを作らないといけないのですが、作り方が全くわかりません。 親切な方、教えてください。 □■□■□■□■□■□■□■□■□■□■□■□■ 名前 金額 日時 ⇒1行目のタイトル Ａさん 100円 12/1 ⇒2行目 200円 12/2 ・・・＊ ⇒3行目 300円 12/3 ・・・＊ ⇒4行目 合計 400円 ⇒5行目 Ｂさん 100円 12/1 ⇒6行目 200円 12/2 ・・・＊ ⇒7行目 300円 12/3 ・・・＊ ⇒8行目 400円 12/4 ・・・＊ ⇒9行目 合計 1000円 ⇒10行目 Ｃさん 100円 12/1 ⇒11行目 200円 12/2 ・・・＊ ⇒12行目 合計 300円 12/3 ⇒13行目 ・ ⇒14行目 ・ ⇒15行目 ・ ⇒16行目 のExcel表があります。 それぞれの人と合計金額の部分までを参照し、合計金額までの前の列(・・・＊の部分)にそれぞれの人の名前を入れたい(コピー・ペーストしたい)です。
- ベストアンサー
- オフィス系ソフト
- エクセルのデータの整理
教えて下さい 仕事で、その時々にデータを入力しているのですが 重複する項目データを合計したいのですがどうしても解りません 日付 得意先 工程 種別 数量 10/1 bbbb x03 A12 59 ** 10/1 ffff y03 A29 29 10/1 bbbb x03 B90 67 10/1 wwww z14 A12 45 10/1 bbbb x03 A12 26 ** 10/2 bbbb x03 A12 83 ： ： こんな具合にデータが続いていくのですが「**」印の行のみ 日付・得意先・工程・種別すべて共通しているのでその数量を合計して 重複したデータ表を整理したいのですが どのようにすれば良いのか解りません マクロかピボットを駆使すれば出来そうな気はするのですが 私の技量では到底かないません どなたか教えて頂けませんでしょうか
- ベストアンサー
- オフィス系ソフト
- WEBクエリを処理していくVBAについて
初めまして。 ExcelのVBAについての質問です。 WEBクエリを用いて、データを回収したいのですが まだVBAを勉強したてで、作りたいものがあるのに 作れず困っています。 sheet1 A列 B列 あああ http://aaaaa.co.jp/aaaa.html いいい http://aaaaa.co.jp/bbbb.html うううう http://aaaaa.co.jp/bbbb.html というものがあり このB列のURLを上から順番にWEBクエリによってデータを得て 「新しいシート」に貼り付け この新しいシートのシート名を、A列の対応する行の名前で順番に付けていきたいです。 aaaa.html → 「あああ」シート bbb.html → 「いいい」シート という感じです。 この処理を何回か続けていくVBAを教えていただきたいです。 宜しくお願い致します。
- 締切済み
- Excel（エクセル）
- Excel VBAの繰返し処理を教えて下さい
マクロを始めたばかりの初心者です。 どなたかご教示下さい。 リストから担当者社員番号をキーとして既定のシートにデータ転記し、別ファイルコピー後名前を付けて保存するというマクロを作成しています。 ご教示頂きたいのは、担当者別にファイルを作成したいのですが、 １行ごとの処理になり、無限ループでVBAが終了しません。 色々調べてみたものの、解決策が見つかりません。 どなたかご教示いただけないでしょうか。 読みにくいコードですが何卒よろしくお願い致します。 サンプルコード Sub 担当者用_個人用() Dim 行 As Integer Dim 年月 As String Dim メール行 As Integer Dim 担当者用 As String Dim 社員番号 As String Dim 社員名 As String Dim 残業対象 As String Dim 所属コード As String Dim 所属名 As String Dim 事業所コード As String Dim 事業所名 As String Dim 社員区分 As String Dim 平日時間外_m As String Dim 休日時間外_m As String Dim 時間外合計 As String Dim 前月時間外合計 As String Dim 前々月時間外合計 As String Dim 平均 As String Dim 問診票 As String Dim 削減書 As String Dim 担当者社員番号 As String Dim 担当者 As String Application.ScreenUpdating = False Sheets("個人用").Select 年月 = InputBox("ＯＴレポートの「年月」を入力してください 例：（前月）2012年9月 → 201209") Range("A2") = 年月 Sheets("健康診断問診票").Select 行 = 5 メール行 = 5 【こちらの繰返し処理が無限ループになっています。ご教示頂けないでしょうか】 Do Until Cells(行, 17).Value = "" If Cells(行, 17).Value <> 担当者社員番号 Then End If 出力処理: 社員番号 = Cells(行, 1).Value 社員名 = Cells(行, 2).Value 残業対象 = Cells(行, 3).Value 所属名コード = Cells(行, 4).Value 所属名 = Cells(行, 5).Value 事業所コード = Cells(行, 6).Value 事業所名 = Cells(行, 7).Value 社員区分 = Cells(行, 8).Value 平日時間外_m = Cells(行, 9).Value 休日時間外_m = Cells(行, 10).Value 時間外合計 = Cells(行, 11).Value 前月時間外合計 = Cells(行, 12).Value 前々月時間外合計 = Cells(行, 13).Value 平均 = Cells(行, 14).Value 問診票 = Cells(行, 15).Value 削減書 = Cells(行, 16).Value 担当者社員番号 = Cells(行, 17).Value 担当者 = Cells(行, 18).Value Sheets("個人用").Select Range("A5").Select Cells(メール行, 1).Value = 社員番号 Cells(メール行, 2).Value = 社員名 Cells(メール行, 3).Value = 残業対象 Cells(メール行, 4).Value = 所属名コード Cells(メール行, 5).Value = 所属名 Cells(メール行, 6).Value = 事業所コード Cells(メール行, 7).Value = 事業所名 Cells(メール行, 8).Value = 社員区分 Cells(メール行, 9).Value = 平日時間外_m Cells(メール行, 10).Value = 休日時間外_m Cells(メール行, 11).Value = 時間外合計 Cells(メール行, 12).Value = 前月時間外合計 Cells(メール行, 13).Value = 前々月時間外合計 Cells(メール行, 14).Value = 平均 Cells(メール行, 15).Value = 問診票 Cells(メール行, 16).Value = 削減書 Cells(メール行, 17).Value = 担当者社員番号 Cells(メール行, 18).Value = 担当者 '個別ファイル作成 Sheets("個人用").Select Sheets("個人用").Copy 年月 = Cells(2, "A") 担当者社員番号 = Cells(5, "Q") 担当者 = Cells(5, "R") Application.DisplayAlerts = False 'メッセージを出さない ActiveWorkbook.SaveAs Filename:="C:\担当者用\" & ("勤怠抽出" & 年月 & "(" & 担当者社員番号 & " " & 担当者 & "さん" & ")") & ".xls" ActiveWorkbook.Save ActiveWindow.Close Sheets("個人用").Select Rows("5:5").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Sheets("健康診断問診票").Select 行の終わり: 行 = 行 + 1 Loop Sheets("ファイル作成").Select Range("A30").Select ActiveWorkbook.Save Application.ScreenUpdating = True MsgBox "ファイル作成が終了しました" End Sub
- ベストアンサー
- その他MS Office製品
- ＶＢＡで複数ファイルからのデータ抽出を行いたい。
すみません、知恵をお貸しください。 ＶＢＡ初心者です。 一つの同じフォルダ内にあるエクセルの同じ形式の複数ファイル（*.xls)から、データを抽出し（例．A2:k2）一つのファイルを作成したいのですが、どうにか一行目だけを抽出することができました。 しかし、データ抽出をしたい複数ファイルの中には（A2:k2)だけではなく、複数行に渡りデータが入っているもの（A3:k3まで、やA5:k5までなど）があり、それら全てを抽出したいのです。 何らかの条件付けの上でループをさせればいいのかな？とも考えたのですが、うまくいきません。 どうかご教授お願いします。
- ベストアンサー
- Visual Basic
- エクセルのシート上でオートフィルターを使ってデータを抽出した際の処理について・・・
素人ゆえわかりづらい質問をどうかご勘弁ください。 エクセルで下記のような金銭出納帳を作ったのですが、オートフィルタでデータを抽出したときに、抽出したデータだけの金額の集計と、その総計を抽出後の一番最後の行の合計額のフィールドに自動的に出し、抽出を解除したときに消えるようにしたく、VBAマクロ組んで試行錯誤したのですが、うまくいきません。どなたか知恵を分けていただけませんか？ （データ抽出後） A B C D E F G E1=入金額 1 # # # # # # # F1=出金額 2 # # # # 5 0 ? G1=合計額 6 # # # # 5 0 ? G2=元金 9 # # # # 5 0 ? 合計 ? オートフィルターで抽出した際自動的に?を求め、抽出を解除したときにそれを消したいのですが・・・
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡを教えてください。
エクセルＶＢＡを教えてください。 エクセル初心者です。 仕事の都合で下記のようなマクロを作らないといけないのですが作り方がよくわかりません・・・。 宜しくお願い致します。 ----------------------------------------------- 列Ａ 列Ｂ 列Ｃ 列Ｄ 1行目 名前 金額 日時 2行目 Ａさん 100円 12/1 3行目 200円 12/2 4行目 300円 12/3 5行目 合計 600円 6行目 Ｂさん 100円 12/1 7行目 200円 12/2 8行目 300円 12/3 8行目 400円 12/4 9行目 合計 1000円 10行目 Ｃさん 100円 12/1 11行目 200円 12/2 12行目 合計 300円 のExcel表があります。 これを下記のように変更したいです。 列を１つ挿入し、追加した列に合計行までそれぞれの人の名前をペーストしたいです。 列Ａ 列Ｂ 列Ｃ 列Ｄ 列Ｅ 1行目 名前 名前 金額 日時 2行目 Ａさん Ａさん 100円 12/1 3行目 Ａさん 200円 12/2 4行目 Ａさん 300円 12/3 5行目 合計 Ａさん 600円 ←合計欄まで名前をコピーしたいです。 6行目 Ｂさん Ｂさん 100円 12/1 7行目 Ｂさん 200円 12/2 8行目 Ｂさん 300円 12/3 8行目 Ｂさん 400円 12/4 9行目 合計 Ｂさん 1000円 10行目 Ｃさん Ｃさん 100円 12/1 11行目 Ｃさん 200円 12/2 12行目 合計 Ｃさん 300円
- ベストアンサー
- オフィス系ソフト
お礼
詳細なご回答を有難うございました。 また、「補足」のルールをわかっておらず、 他の方にも参照としてしまい申し訳ございませんでした。 初心者で検証に時間がかかってしまうかと思いますが、 ご教示頂いた方法でやってみます。 本当に有難うございました。