- 締切済み
データ抽出に時間がかかり困っています
皆様大変お世話になっております。ところで、データ抽出の件で大変困っておりまして、ご教授いただきたくご連絡差し上げました(使用OSはXP、エクセルは2007です。)。企業の決算期データを抽出したいのですが、毎年度決算月のみのデータを月次データからどのようにすれば速く抽出できるかで悩んでおります。データの構成は：A列に年度・決算月（例えば、1978/03)、B列に企業コード、C列に年度・月（例えば、1984/01)、D列に企業コード、E列にはC・D列に対応した月次データが入力されております。A・B列は（各企業の年毎の決算月）各70698行、C・D・E列は（各企業の月次毎データ）各248964行となっております。ここで、A・B列に等しいC・D列のセルをみつけ、その横のE列の値を当該A・B列に対応した行のF列に書き出させたいのです（回りくどい説明で申し訳ありません。）。初心者ながら、いろいろなVBA説明ページを参照しつつ、以下のコードを作成しました： Sub Sorting01() Dim ra As Long, rc As Long Application.ScreenUpdating = False For ra = 3 To Range(A70698).End(xlUp).Row If Cells(ra, 1) <>"" Then For rc = 3 To Range(C248964).End(xlUp).Row If Cells(rc, 3) <>"" And Cells(ra, 1).Value = Cells(rc, 3).Value And Cells(ra, 2) = Cells(rc, 4) Then Cells(ra, 7).Value = Cells(rc, 5).Value Exit For End If Next rc End If Next ra MsgBox Done End Sub データの一部（100行分）を別のシートに貼り付けて動くかどうか試したところ、問題ありませんでしたが、元のデータに適用したところ、とてつもなく時間がかかっております。上述のコードが非常に非効率的なものではないかと考えております。初心者で誠に恥ずかしい限りですが、きわめて急いでいることもありご連絡差し上げました。時間短縮のため、効率的なコード、または他の方法（関数）がありましたら、教え願いたく存じます。重ねながら、どうぞ宜しくお願いいたします。 追伸：A列・C列の/は取り除き数字の状態に変えてあります（例えば、1977/01 =>197701)。一点、申し上げておきたいことは、B列に出てくるコードがD列に必ずしもあるわけではありません。
- io_vba
- お礼率100% (4/4)
- SE・インフラ・Webエンジニア
- 回答数4
- ありがとう数22
- みんなの回答 （4）
- 専門家の回答
みんなの回答
- iriyak
- ベストアンサー率48% (40/82)
お身体をお大事に！ Awk の件ですが、Windows プラットフォームでは gawk.exe (Awk 拡張) を使用可能です。Windows で使用する際、コマンドプロンプト (cmd.exe) 上で操作するのに若干の慣れが必要ですが、余りあるメリットを享受できると思います。ぜひトライください。 (gawk.exe に関する情報満載のサイト) http://www.kt.rim.or.jp/~kbk/gawk-3.1/ (iriyak Awk 関連回答QNo) QNo.4160141 テキスト編集 http://okwave.jp/qa4160141.html QNo.431310 awkという言語について http://okwave.jp/qa431310.html QNo.3865890 shell(awk)でファイル内の同一キーをグループ化 http://okwave.jp/qa3865890.html QNo.4138535 複数のテキストから同じ行数の文字列を抽出し，別のテキストに出力する方法 http://okwave.jp/qa4138535.html QNo.4130570 awk と gawk の書き方の違い http://okwave.jp/qa4130570.html QNo.4073795 awkの処理速度を改善したい http://okwave.jp/qa4073795.html QNo.4067666 awk in csh http://okwave.jp/qa4067666.html QNo.4064522 awkを使って文字列処理の問題 http://okwave.jp/qa4064522.html QNo.4040998 バッチ処理でテキストから数値を取り出し、CSVにしたい http://okwave.jp/qa4040998.html
- iriyak
- ベストアンサー率48% (40/82)
こんにちは。 目的達成のために Excel VBA を使用する、という条件を緩くすることは可能でしょうか。例えば、テキスト処理言語 Awk を適用するなど。 (回答者のコメント) 回答者も同様の実務にトライしたいことがあり、結論として Awk に切り替えました。計算の核となるところは。
お礼
iriyak様、ご連絡が遅くなり大変申し訳ありません。体調不良により倒れておりました。無礼をお許しいただければ幸いです。併せて、Awkの存在をお知らせ頂き、誠にありがとうございます。勉強を始めようと思います。 現状ですが、結局、6日間PCを動かし続けて、データの整理を終えました。（私見ですが）非効率的なコードながら、どうにか正しい整理が出来たようです。 今後とも、どうぞ宜しくお願い致します。取り急ぎ、ご連絡まで。
- tomo316
- ベストアンサー率35% (51/142)
248964件からの抽出はエクセルではきついと思います。 以下の構成に変更をお勧めします。 エクセル 現在のシート ↓（アクセスでインポートORテーブルのリンク） アクセス 抽出（クエリー） ↓（アクセスでエクスポート） エクセル 表示
お礼
tomo316様、 ご回答頂き、感謝しております。ありがとうございます。併せて、ご連絡が遅くなり誠に申し訳ありません。ご寛恕頂ければ幸いです。 データの量に応じて抽出処理のスピードがかなり落ちるのですね。エクセル初心者のため全く想定しておりませんでした。お恥ずかしい限りです。アクセスでの対応をお教えいただき、ありがとうございます。また一から勉強しないと、ですね。 今後ともどうぞ宜しくお願い致します。取り急ぎ、ご連絡まで。
- higekuman
- ベストアンサー率19% (195/979)
値が一致するかどうかを調べるときにもForループを使っていますが、Findメソッドを使ってみてはいかがでしょうか？ このコードを書けるくらいなので、このヒントだけでも大丈夫だと思っています。
お礼
higekuman様、迅速なご回答ありがとうございます。小生、理解度の低い初心者ですが、今後ともどうぞ宜しくお願いいたします。ところで、Findメソッドについては自分なりに調べてみますが、かなり切羽詰まっております。手前勝手な考えですが、見本コードがあれば、それを基に理解が速くなるかなと期待しています。重ねながら、ご回答ありがとうございました。
関連するQ&A
- EXCEL VBA データ抽出について
ユーザーフォームを利用して、データの管理を行なっております 各データには、コードを設定しており 検出時に利用しています フォームでコードを入力する際には 前半（年・月） 後半（No.）で２か所に分けて入力しており 以下、コード前半⇒ コード１ コード後半⇒ コード２ ・・・としておきます シートへの転記も、コード１はA列・コード２はB列に分けて書き込んでいます 以下は、コードからデータを検出し、その内容をテキストボックスへ表記するように 書いたコードですが、コード１のみでの検索になっております コード２をどのように組み込めばいいのか、わからずとても困っています。 シート名 AllDate コード１ TextBox36 （A列） コード２ TextBox37 （B列） １行目は項目名になっており、２行目からデータが蓄積されています。 また新規で登録した場合には、空欄最下部へフォームからシートへ転記されるように設定しています ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Worksheets("AllDate").Activate Dim i As Long, kb As String If TextBox36.Text = "" Then MsgBox "検索する番号を入力してください" Exit Sub End If For i = 2 To Range("A1").CurrentRegion.Rows.Count If Cells(i, 1).Text = TextBox36.Text Then kb = TextBox36.Text Exit For End If Next If kb = "" Then MsgBox "指定した番号はありません" Exit Sub Else Call ReadRecord(kb) End If TextBox36.Text = "" TextBox37.Text = "" End Sub Sub ReadRecord(kb As String) Dim rw As Long Set kRange = Range("A1").CurrentRegion.Columns(1).Find(What:=kb, LookAt:=xlWhole) If kRange Is Nothing Then MsgBox "データがありません" Exit Sub End If rw = kRange.Row TextBox1.Text = Cells(rw, 1).Value TextBox2.Text = Cells(rw, 2).Value TextBox3Text = Cells(rw, 3).Value TextBox4.Text = Cells(rw, 4).Value ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ また自分なりにも何とか模索しており、フィルターを使う方法も考えておりますが 何分まだまだ初心者LVの為、 こちらも難航しております。 フィルタを使用する場合 TextBox36の値で、A列にて抽出 抽出されたデータから、さらに TextBox37の値で、B列にて抽出 重複データは存在しないので、A２行へ常に１件のデータが残り それをセル指定で、テキストボックスへ転記さようと考えています。 また、修正⇒上書き作業も必要なので フィルタで抽出したデータをテキストボックスへ表示させ 修正後、同様にA２行へ書き込み その後、フィルター解除がいいのかな？と思っています。 長々となり恐縮なのですが 方法のオススめ コードのご教授など お力をお貸しいただけないでしょうか？ よろしくお願いいたします！！
- 締切済み
- Visual Basic
- マクロ：データの抽出（複数条件）
エクセルで以下のようなマクロを作成しました。 シート1のG列がシート2のF4と合致する時、シート2のＣ列にシート1のＢ列を貼り付けるのですが、条件を増やし 「シート1Ｇ列がシート2のＦ４と一致」かつ「シート1Ｈ列がシート2のG5と一致」かつ「シート1I列がシート2のH5と一致」かつ・・・としたいのですが、If Thenをどのように記述したらよろしいでしょうか。（AND関数の機能です） 宜しくお願いいたします。 Sub data01() With Sheets("Sheet1") x = .UsedRange.Cells(.UsedRange.Count).Row For i = 5 To x If .Cells(i, "G").Value = Worksheets("Sheet2").Range("F4").Value Then n = n + 1 Sheets("Sheet2").Cells(n + 5, "C").Value = .Cells(i, "B").Value End If Next End With End Sub
- ベストアンサー
- オフィス系ソフト
- アプリケーション定義または、オフジェクトエラー
office2010 マクロ実行で”アプリケーション定義または、オフジェクトエラー"が発生します いろいろ調べてみたのですが、原因分からず、教えてください。 Sheet1のA1～A8までシート名が記載されています。 このシート名の後ろにdataを付与してシートを追加し、編集用とするマクロです。 Macro13を実行してMacro1のエラー発生という所が黄色くなります。 ' Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=A1管理!RC[-4]" の場合は、動作します。 なので、 Worksheets(""SHEET1"").Cells(i, 1).value! が悪いと思うのですが、どうしたらよいかが分かりません。 Dim i As Long Sub Macro13() ' Sheets("Sheet1").Select For i = 1 To Range("A1").End(xlDown).Row With Worksheets.Add() .Name = Worksheets("SHEET1").Cells(i, 1) & "data" Call Macro1 End With Next End Sub Sub Macro1() ' 各シートの整列版作成 ' 'データ参照 ' Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=A1管理!RC[-4]" '動作Ok Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=Worksheets(""SHEET1"").Cells(i, 1).value!RC[-4]" ’エラー発生 '下記は編集内容 'D列：F列を参照し、先頭６桁の右３文字がドライだったらTD、先頭６桁の右３文字がレンチだったらTL Range("D1:D" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RIGHT(LEFT(RC[2],6),3)=""ドライ"",""TD"",IF(RIGHT(LEFT(RC[2],6),3)=""レンチ"",""TL"",""""))" '計算用に１行ダミー行挿入 Range("A1").Select Selection.EntireRow.Insert 'C列：E列を参照し、セル結合されているセルを名称、フロント、リアの区分名とする Range("C2:C" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RC[2] <>0,RC[2],R[-1]C)" 'B列：E列を参照し、先頭１桁がNだったら名称、0だったらＢ列1つ上の名称 Range("B2:B" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(LEFT(RC[3],1)=""N"",RC[3],R[-1]C)" 'A列：B,C,D列を結合 Range("A2:A" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RC[1]=RC[2],"""",CONCATENATE(RC[1],RC[2],RC[3]))" End Sub
- ベストアンサー
- Excel（エクセル）
- Excelで同一セル内に入力されているデータを他のセルに分割したい
http://okwave.jp/qa4369634.html?ans_count_asc=20 で質問をして、何度かやりとりをさせていただいて エクセルで同一セル内に、セル内改行で１～６列ほどのデータが入力されています。 縦にデータが入力されていて、それぞれのセルにセル内改行を含み、データが入力されています。 それぞれのセル内のデータを… 例えば、A1セル内に５行入力されていたら、A2セルから入力されている行数分（ここでいうと5行）挿入し、それぞれにデータを分割して入力させたい。 かつ、B・Cセルは増えたセルにそれぞれのデータをコピーしたいと言ったら、 Sub Macro1() Dim idx, cnt As Integer Dim wkStr() As String Dim rng As Range ActiveSheet.Copy after:=ActiveSheet For idx = Range("A65536").End(xlUp).Row To 1 Step -1 If InStr(Cells(idx, "A"), Chr(10)) > 0 Then wkStr = Split(Cells(idx, "A").Value, Chr(10)) Set rng = Cells(idx, "B") For cnt = UBound(wkStr) To 0 Step -1 Cells(idx, "A").Value = wkStr(cnt) Cells(idx, "B").Value = rng.Value Cells(idx, "C").Value = rng.Offset(0, 1).Value If cnt > 0 Then Cells(idx, "A").Resize(1, 3).Insert shift:=xlDown End If Next cnt End If Next idx End Sub といったマクロのご回答をいただきました。 これを元に、 ・データが入っているセルをA列→B列に変更 ・A列のデータはセルが増えた分だけ増やしたい ・A1に対応するデータがC1・D1に入っていた場合、対応するデータは残したまま、B列が増えただけ、列を増やしたい と変更したいのですが…。 すいませんが、宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- データ抽出について教えて下さい。
以前質問し、マクロを作って頂いたのですが、行と列を挿入しなくてはならなくなり、マクロが機能しなくなってしまいました。 ●以前の質問● セルA1：カベシタジゴウハン 9X 50X1800 D9 セルA2：ウケゴウハン T5.5 40X 300 U7 セルA3：ゴウハンK 2.5X 60X 80 スペーサー セルA4：ランバP *412X3547 W2 セルA5：VSF K 12.5X 47X 869 LE セルA6：VSF J*12X 68X2395 Wメン WX とシートに入っているとします。これを、 セルB1：9 セルC1：50 セルD1：1800 セルB2：5.5 セルC2：40 セルD2：300 セルB3：2.5 セルC3：60 セルD3：80 セルB4：空白 セルC4：412 セルD4：3547 セルB5：12.5 セルC5：47 セルD5：869 セルB6：12 セルC6：68 セルD6：2395 と入るように関数を使うにはどうしたら良いでしょうか。 マクロでも構いません。 ●採用させて頂いた回答● Sub test() Dim i, ii, iii Dim a As String For i = 1 To Range("a65536").End(xlUp).Row a = "" iii = 0 For ii = 1 To Len(Cells(i, 1).Value) If IsNumeric(Mid(Cells(i, 1).Value, ii, 1)) Or Mid(Cells(i, 1).Value, ii, 1) = "." Then a = a & Mid(Cells(i, 1).Value, ii, 1) ElseIf a <> "" Then Cells(i, 2).Offset(, iii).Value = a a = "" iii = iii + 1 End If If iii = 3 Then Exit For Next ii Next i End Sub ●今回セルが変わりました● セルB2：カベシタジゴウハン 9X 50X1800 D9 セルB3：ウケゴウハン T5.5 40X 300 U7 セルB4：ゴウハンK 2.5X 60X 80 スペーサー セルB5：VSF K 12.5X 47X 869 LE セルB6：VSF J*12X 68X2395 Wメン WX とシートに入っています。これを、 セルC2：9 セルD2：50 セルE2：1800 セルC3：5.5 セルD3：40 セルE3：300 セルC4：2.5 セルD4：60 セルE4：80 セルC5：12.5 セルD5：47 セルE5：869 セルC6：12 セルD6：68 セルE6：2395 このように入るようにしたいのです。 以前採用させて頂いたマクロを修正したいのですが、どうも自分では失敗してしまいます。 お力をお貸し頂ければ幸いです。
- ベストアンサー
- その他(業務ソフトウェア)
- 【Excel VBA】抽出したデータを書式へ
Excel2003を使用しています。 Excelで作成→送付されてくる全店データの中から自店のデータのみを抽出し、全店データと同じ書式で自店のみのデータを作成したく、下記のようにコードを書きました。 ------------------------------------------------------- Sub Macro1() Dim i As Long Dim j As Long Dim LastR As Long LastR = Sheets("全店データ").Range("E65536").End(xlUp).Row With Sheets("自店データ") For i = 34 To LastR If Sheets("全店データ").Cells(i, "E").Value Like "*A店*" Then .Cells(j, "C").Value = Sheets("全店データ").Cells(i, "C").Value .Cells(j, "E").Value = Sheets("全店データ").Cells(i, "E").Value .Cells(j, "I").Value = Sheets("全店データ").Cells(i, "I").Value .Cells(j, "W").Value = Sheets("全店データ").Cells(i, "W").Value .Cells(j, "AA").Value = Sheets("全店データ").Cells(i, "AA").Value .Cells(j, "AE").Value = Sheets("全店データ").Cells(i, "AE").Value .Cells(j, "AI").Value = Sheets("全店データ").Cells(i, "AI").Value .Cells(j + 1, "C").Value = Sheets("全店データ").Cells(i + 1, "C").Value .Cells(j + 1, "I").Value = Sheets("全店データ").Cells(i + 1, "I").Value j = j + 2 End If Next i End With End Sub ------------------------------------------------------- 元の書式は、データ1件が2行で、結合セルも含まれているので、コピペするより、Value = Value が扱いやすい(？)かと思い、上記のように書いてみました。 自店のデータが1ページ分(14件分28行で、セル34行目～61行目)内に収まる場合は問題ないのですが、それ以上になった場合をどのように記述すればよいのか躓いています。 書式は、 1ページ目 34行目～61行目 2ページ目 73行目～128行目 3ページ目 140行目～195行目 4ページ目 207行目～262行目 5ページ目 274行目～329行目 6ページ目 341行目～396行目 このような書式にデータを代入する場合は、上記の方法では難しいでしょうか？ 説明が分かりづらくて申し訳ありませんが、よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- loop終了後のセルの一個右から同様のloopを行う方法
・loop終了後のセルの一個右から同様のloopのプログラムを組むのが目的です。 ・データはA列にランダムに数字が入っているものとします。 ・条件式としては基準値より小さな数字が一個下のセルにあったら↓を表示して、さらに下に行くという風にして、基準よりも多くなったところでloopがストップする設定です。 ・困っているところをうまく表現できてないかも知れませんが、よろしくお願いします。 --------------------------- Sub 比較() Dim i As Integer Dim j As Integer Cells(1, 2).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R1C1,""→"",""↓"")" i = 1 Do While Cells(i, 2).Value <> "" If Cells(i, 2).Value = "↓" Then Cells(1 + i, 2).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R1C1,""→"",""↓"")" End If i = i + 1 Loop Cells(i - 1, 3).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R" & i - 1 & "C1,""→"",""↓"")" j = 1 Do While Cells(i - 2 + j, 3).Value <> "" If Cells(i - 2 + j, 3).Value = "↓" Then Cells(i - 1 + j, 3).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R" & i - 1 & "C1,""→"",""↓"")" End If j = j + 1 Loop End Sub
- ベストアンサー
- Visual Basic
- 重複データーの集計、削除
どなたかご教授下さい。 下記のようにD列に重複する行があればI列に集計し、行削除するマクロを作成しました。 さらに、重複する基準となる列を複数(D列,F列,Ｇ列)に増やしたいのですが、上手く出来ません。 宜しくお願い致します。 Sub test() Dim i, j For i = 19 To Cells(Rows.Count, 2).End(xlUp).row - 1 For j = Cells(Rows.Count, 2).End(xlUp).row To i + 1 Step -1 If Cells(i, 4).value = "" Then Exit Sub If Cells(i, 4).value = Cells(j, 4).value Then Cells(i, 9).value = Cells(i, 9).value + Cells(j, 9).value Rows(j).Delete End If Next Next End Sub
- 締切済み
- Visual Basic
- vbaプログラミングについて教えてください。
vba初心者です。下記のようにプログラミングしましたがもっといいプログラムの仕方はないでしょうか。ちょっとごちゃごちゃしていて見にくいです。どなかたお力をお貸しください。 Private Sub データUPDATE輸入_Click() ActiveSheet.Unprotect Dim Line As String Dim Maxrow As String Sheets("Invoice").Select Line = 5 Do Until Cells(Line, 7).Value = "" On Error Resume Next 'A列の空欄をコピーして埋める If Cells(5, 1).Value = "" Then Cells(Line, 1).Value = "" ElseIf Cells(Line, 1).Value = "" Then Cells(Line, 1).Value = Cells(Line - 1, 1).Value End If 'B列の空欄をコピーして埋める If Cells(5, 2).Value = "" Then Cells(Line, 2).Value = "" ElseIf Cells(Line, 2).Value = "" Then Cells(Line, 2).Value = Cells(Line - 1, 2).Value End If 'C列の空欄をコピーして埋める If Cells(5, 3).Value = "" Then Cells(Line, 3).Value = "" ElseIf Cells(Line, 3).Value = "" Then Cells(Line, 3).Value = Cells(Line - 1, 3).Value End If 'D列の空欄をコピーして埋める If Cells(5, 4).Value = "" Then Cells(Line, 4).Value = "" ElseIf Cells(Line, 4).Value = "" Then Cells(Line, 4).Value = Cells(Line - 1, 4).Value End If 'E列の文字を「輸入シート」から検索しF列に貼り付ける If Cells(Line, 5).Value = "" Then Cells(Line, 5).Value = Cells(Line - 1, 5).Value End If Cells(Line, 6).Value = Application.WorksheetFunction.VLookup(Cells(Line, 5).Value, Worksheets("輸入Parts").Range("A2:R20000"), 2, 0) 'E列を検索しデータが存在しない場合はF列に「データがありません」を表記 If Cells(Line, 6).Value = "" Then Cells(Line, 6).Value = "データがありません" GoTo コピー貼り付け End If コピー貼り付け: If Cells(Line, 6).Value = "データがありません" Then Cells(Line, 5).Copy 'コピーする Maxrow = Worksheets("輸入Parts").Range("A1").End(xlDown).Row + 1 Worksheets("輸入Parts").Range("A" & Maxrow).PasteSpecial Paste:=xlPasteValues '値を貼り付け End If 'H列の空欄をコピーして埋める If Cells(5, 12).Value = "" Then Cells(Line, 12).Value = "" ElseIf Cells(Line, 12).Value = "" Then Cells(Line, 12).Value = Cells(Line - 1, 12).Value End If 'E列の文字を「輸入シート」から検索しZ列に貼り付ける Cells(Line, 26).Value = Application.WorksheetFunction.VLookup(Cells(Line, 5).Value, Worksheets("輸入Parts").Range("A2:R20000"), 3, 0) 'E列を検索しデータが存在しない場合はZ列に「データがありません」を表記 If Cells(Line, 26).Value = "" Then Cells(Line, 26).Value = "データがありません" End If 'AD列の空欄をコピーして埋める If Cells(5, 30).Value = "" Then Cells(Line, 30).Value = "" ElseIf Cells(Line, 30).Value = "" Then Cells(Line, 30).Value = Cells(Line - 1, 30).Value End If 'E列の文字を「輸入シート」から検索しAM列に貼り付ける Cells(Line, 39).Value = Application.WorksheetFunction.VLookup(Cells(Line, 5).Value, Worksheets("輸入Parts").Range("A2:R20000"), 18, 0) 'E列を検索しデータが存在しない場合はAM列に「データがありません」を表記 If Cells(Line, 39).Value = "" Then Cells(Line, 39).Value = "データがありません" End If '「Unit price」の計算・円建と外貨建が合わさったインボイスの場合の合計金額 If Cells(Line, 14).Value = "" Then Cells(Line, 13).Value = Cells(Line, 17).Value * Cells(Line, 33).Value / Cells(Line, 7).Value Else Cells(Line, 17).Value = Application.WorksheetFunction.RoundDown(Cells(Line, 14).Value * Cells(Line, 16), 0) Cells(Line, 15).Value = Cells(Line, 16).Value * Cells(Line, 33).Value / Cells(Line, 7).Value End If 'T.Invoice Priceの計算 Cells(Line, 23).Value = Application.WorksheetFunction.Sum(Cells(Line, 17), Cells(Line, 18), Cells(Line, 19), Cells(Line, 20), Cells(Line, 21), Cells(Line, 22)) 'VLOOKUP関数が終わり、エラーが発生したら止まる On Error GoTo 0 '次の行に移り最後の行まで検索 Line = Line + 1 Loop End Sub
- 締切済み
- Visual Basic
- 終了日時から開始日時を引いた時間を求めるvba式
お世話になっています。 Excelで A列欄にタイトル B列欄に開始日 C列欄に開始時 D列欄に終了日 E列欄に終了時 のデータが有ります。 F列欄に合計を求めたいです。 今回は、 For～Next間のコードを教えて下さい 前回質問分 http://okwave.jp/qa/q9213232.html Option Explicit Public i As Long Public num As Integer Sub newmacro() Range("F1").Value = "合計" Columns("F").Select Selection.NumberFormatLocal = "[h]:mm" For num = 2 To Range("a1").End(xlDown).Row Cells("F", num).Value = Cells("D", num).Value + Cells("E", num).Value - Cells("B", num).Value + Cells("C", num).Value Next num End Sub よろしくお願い致します
- ベストアンサー
- Excel（エクセル）
お礼
iriyak様、ご親切な対応に心より感謝いたします。ありがとうございました。 今後とも、問題のある時にはこちらのコミュニティーにお世話になる所存です。その折にも、どうぞ宜しくお願い致します。 重ねながら、ありがとうございました。