- ベストアンサー
VBAプログラミングで大量のデータをSheet2に書き込む方法
tossy005の回答
連続投稿申し訳ありません。 第2列と第4列の値が半角なのかどうかご確認下さい。 調査用に下記のように変更したマクロを使用すると便利かもしれません。 Dim n As Long Dim m As Long dim gyou As String dim retsu As String On Error Goto ErrorCheck n = 9104 m = 48881 For k = 1 To n gyou = Worksheets("Sheet1").Cells(k + m, 2) retsu = Worksheets("Sheet1").Cells(k + m, 4)) Worksheets("Sheet3").Cells(1 + Worksheets("Sheet1").Cells(k + m, 2), 1 + Worksheets("Sheet1").Cells(k + m, 4)) = Worksheets("Sheet1").Cells(k + m, 5) Next k ErrorCheck: MsgBox "Sheet1の" & Cstr(k + m) & "行目のデータがおかしいです。" & VBCrlf _ & "第2列 = " & gyou & ":第4列 = " & retsu
関連するQ&A
- vbaでオーバーフローしてしまいました。
Dim i As Long Dim k As Long For i = 1 To 829 For k = 1 To 995 Worksheets("2").Cells(k,i) = Worksheets("1").Cells(k,i) /Worksheets("1").Cells(996,i) Next k Next i これを実行したらオーバーフローしてしまい、途中までしか計算できませんでした。 解決方法を教えて頂きたいです。よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAについて
前回質問させていただきました件の追加機能になります。以前質問させていただきましたマクロが下記のものです。 Sub TESTa() Dim A As Long Dim B As Long Dim C As Long Dim D As Long Dim E As Long Dim F As Long '表の行数を調べる A = Worksheets("sheet1").Range("C65536").End(xlUp).Row - 1 For C = 1 To A For B = 4 To 7 'Sheet1のデータをSheet2に複写する Worksheets("Sheet2").Cells(B - 3 + D, 15) = Worksheets("Sheet1").Cells(C + 1, 1) Worksheets("Sheet2").Cells(B - 3 + D, 6) = Worksheets("Sheet1").Cells(C + 1, B) Worksheets("Sheet2").Cells(B - 3 + D, 14) = Worksheets("Sheet1").Cells(C + 1, 3) Worksheets("Sheet2").Cells(B - 3 + D, 10) = Worksheets("Sheet1").Cells(1, B) Worksheets("Sheet2").Cells(B - 3 + D, 13) = Worksheets("Sheet1").Cells(C + 1, 2) Next D = C * 4 Next 'Sheet2の表の行数を調べる Sheets("Sheet2").Select E = Worksheets("sheet2").Range("F65536").End(xlUp).Row '0欄の確認 For F = E To 1 Step -1 If Worksheets("Sheet2").Cells(F, 6) = 0 Then '0の場合は行を削除する Cells(F, 1).EntireRow.Delete End If Next End Sub カウントするとデータ個数がSheet1で約１２０件になりSheet2においては、４倍になりますので約４８０件になります。 そこで Sheet1において１２件ごとに、Sheet2,3,4...としたいのです。 Sh1 NO.1～12がSheet2 Sh1 NO.13～24がSheet3 ... 10枚のシートにしたいのですが、このマクロにどのような命令を加えればよろしいでしょうか？ お手数ですがよろしくお願いいたします。
- 締切済み
- オフィス系ソフト
- ExcelのVBAの配列に関する質問です。
ExcelのVBAの配列に関する質問です。 sheet1のデータをsheet2に表示するVBAを作成しています。。 sheet1のデータは7行目からスタートし、sheet2のデータは26行目からスタートしています。。 sheet1とsheet2の列は同じ並びではないため、それぞれのシートの列番号をCellsを用いて指定しています。 Sub test1() Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 Worksheets("sheet2").Cells(j, 1) = Worksheets("sheet1").Cells(i, 2) Worksheets("sheet2").Cells(j, 8) = Worksheets("sheet1").Cells(i, 28) Worksheets("sheet2").Cells(j, 9) = Worksheets("sheet1").Cells(i, 31) Worksheets("sheet2").Cells(j, 10) = Worksheets("sheet1").Cells(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub 上記のtest1は正常に動くのですが、データ量が多いため、処理に時間がかかってしまいます。 高速化できないかと、以下のように変更しました。 Sub test2() Dim dataRange1 As Variant Dim dataRange2 As Variant dataRange1 = Worksheets("sheet1").Range("A1:GI10006") dataRange2 = Worksheets("sheet2").Range("A1:DZ10018") Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 dataRange2(j, 1) = dataRange1(i, 2) dataRange2(j, 8) = dataRange1(i, 28) dataRange2(j, 9) = dataRange1(i, 31) dataRange2(j, 10) = dataRange1(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub test2は、エラーメッセージ等は表示されませんが、sheet2にデータが表示されません。 ちなみに、以下のようにsheet1のみ配列化した場合は、正常に表示されました。 Worksheets("sheet2").Cells(j, 1) = dataRange1(i, 2) Worksheets("sheet2").Cells(j, 8) = dataRange1(i, 28) Worksheets("sheet2").Cells(j, 9) = dataRange1(i, 31) Worksheets("sheet2").Cells(j, 10) = dataRange1(i, 32) test2は、どこが間違っているのでしょうか？ ご教示ください。 よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- エクセルＶＢＡ（掛け算）
いつもおせわになります。 現在、下記のようなコードを書いてますがどうもうまくいきません。よろしくお願いいたします。 Ｍ列 ＝ Ｋ列 × Ｎ列を６行目から最終行目で入れたくて下記のようなコードを書きました。 ところが・・・Ｎ列にはデータのない場合があるので、Ｉｆ～を入れてみました。ここまではうまくいったのですが、 Ｏ列 ＝ Ｋ列 × Ｐ列のように数式を入れたい列が他にもあり、又同じコードを下記のように書いたら、Ｐ列にデータがないところで止まってしまいます。 '///////////////////////////////////////////// Dim wsS As Worksheet Dim r As Long Dim Srow As Long Set wsS = Worksheets("syukei") Srow = wsS.Range("D65536").End(xlUp).Row With Worksheets("syukei") For r = 6 To Srow If Cells(r, 12) = Noting Then r = r End If Cells(r, 13) = Cells(r, 11) * Cells(r, 12) Next End With With Worksheets("syukei") '↓////////ここらへんで止まる////////// For r = 6 To Srow If Cells(r, 14) = Noting Then r = r End If Cells(r, 15) = Cells(r, 11) * Cells(r, 14) Next End With End Sub 掛け算を入れたい行は、下記のようになっています。 Ｍ列＝Ｋ列×Ｌ列 Ｏ列＝Ｋ列×Ｎ列 Ｑ列＝Ｋ列×Ｐ列 Ｓ列＝Ｋ列×Ｒ列 Ｕ列＝Ｋ列×Ｔ列 Ｗ列＝Ｋ列×Ｖ列 Ｙ列＝Ｋ列×Ｘ列 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- VBAについて
はじめまして、以下のVBAについて質問させてください。 A列にデータの個数だけ連番を振りたくて、以下のVBAを入力しました。 連番を振るシートは複数あり、そのシートによってデータの個数は異なります。 しかし、以下のVBAだと最初のシートの個数に応じて、後のシートの連番も振られてしまいます。データの個数に応じてシートごとに連番を振るには、どうすればよいのでしょうか…？！どうか迷える子羊をお助け下さい(T_T) '一番はじめのシートを選択 Sheet "一番".Select 'Ａ列に連番を振る Dim sh As Variant For sh = 3 To Worksheets.Count Dim number As Integer Dim 行2 As Long number = 1 '2行目～最終行までループ For 行2 = 3 To Cells(Rows.Count, 2).End(xlUp).Row Worksheets(sh).Cells(行2, 1) = number number = number + 1 Next 行2 Next sh
- ベストアンサー
- Excel（エクセル）
- Excel VBAで検索する
Excel VBAで、Sheet1に貼り付けたテキスト内から Sheet2に記載した(1列ごとの)キーワードを検索し キーワードが含まれている行をSheet3に貼り付ける処理をしているのですが、始めたばかりなので上手くいきません。 下記がソースです。 Dim moji As String Dim word As String Dim result As Integer For i = 3 To 103 For j = 2 To 21 moji = ThisWorkbook.Worksheets("Sheet1").Cells (i, 1).Value word = ThisWorkbook.Worksheets("Sheet2").Cells (j, 2).Value result = InStr(moji, word) If doResult <> 0 Then For k = 1 To 100 ThisWorkbook.Worksheets("Sheet3").Cells (k, 1).Value= moji Next k End If Next j Next i このソースでは上手くいかないのですが、どこがダメなのか分からないので、解決の糸口がつかめません。 アドバイスなどお願いします。
- ベストアンサー
- その他（プログラミング・開発）
- Excel VBA; 複数のループ処理
↓のようなコードがあります。 Dim i As Long, MaxRow1 As Long, MaxRow2 As Long MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To MaxRow1 Worksheets("Sheet1").Cells(i, 1).Value = i . Next i For i = 1 To MaxRow2 Worksheets("Sheet2").Cells(i, 1).Value = i . Next i これらを最大行の多いシートに合わせて、パフォーマンスを良くしたいと思います。 同様の処理をシート1、シート2で実施しているので纏めて記述したいです。 シート1、シート2に対する処理をサブルーチンにする方法しかありませんか? どなたかお願いします。 If MaxRow1 >= MaxRow2 Then For i = 1 To MaxRow1 Else For i = 1 To MaxRow2 End If Worksheets("Sheet1").Cells(i, 1).Value = i Worksheets("Sheet2").Cells(i, 1).Value = i . Next i
- ベストアンサー
- Visual Basic
- ExcelVBAマクロで貼り付け先の配列化について
ExcelVBAマクロについて確認させてください。 プログラム高速化のために２番目のワークシート貼り付け先範囲を配列化しました。 １番目のワークシートの文字をtrim関数によって前後の空白を除去したうえで２番目のワークシートに貼り付けようとしていますが、空白が除去できていない状況です。 何か原因なのでしょうかm(__)m Sub test() Dim x As Long Dim y As Long Dim x2 As Long Dim y2 As Long Dim a As String Dim Table As Variant '配列化のため '最大列取得 x = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column '最大行取得 y = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row Table = Worksheets(2).Range(Worksheets(2).Cells(1, 1), Worksheets(2).Cells(y, x)) '貼り付け先範囲を配列化 For x2 = 1 To x '最大列 For y2 = 1 To y '最大行 a = Worksheets(1).Cells(y2, x2).Value Table(y2, x2) = Trim(a) 'ワークシート１の値から前後空白を取り除いてワークシート２に貼り付け Next Next End Sub
- ベストアンサー
- Visual Basic
- VBAで B.xlsの番号と同じ番号がD.xlsにあればくっつけたい
VBAで B.xlsの番号と同じ番号がD.xlsにあればくっつけたい エクセル関数でいうとVlookUPをしたいのですが、1004エラーがかかってしまいます。 必要なところだけを抜き取っているので、分かりにくいかと思いますが、 Dim a, b, c, d, y, x, z, i, j, k, m, n, o, r As Long a = 2 '2 なのは、A2から数えるため。 b = 0 'BookBのレコードの数を数えるための変数。 Do While Workbooks("B.xls").Worksheets("Sheet1").Cells(a, 1) <> "" a = a + 1 b = b + 1 Loop Workbooks("B.xls").Activate For k = 2 To b For m = 2 To 300000 エラー⇒ If Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 1) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 1) Then Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 12) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 2) Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 13) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 3) End If Next m Next k ・ ・ ・ の部分でつまっています＞＜； 説明が不十分でしたら追加いたしますので、初心者の簡単なエラーだとは思うのですが、教えてください＜（＿＿）＞
- ベストアンサー
- その他（プログラミング・開発）
- ExcelにおけるVBAで、データの振り分けをしたい
Sub a() Dim i As Long Dim s As Long Dim b As Worksheet Dim c As Worksheet Dim maxi As Long Dim maxs As Long Application.ScreenUpdating = False With ThisWorkbook Set b = .Worksheets("bbb") Set c = .Worksheets("ccc") End With maxi = b.Range("A1").CurrentRegion.Rows.Count maxs = c.Range("A1").CurrentRegion.Rows.Count For i = maxi To 2 Step -1 For s = maxs To 2 Step -1 If c.Cells(s, 1) = b.Cells(i, 1) And c.Cells(s, 2) = b.Cells(i, 2) Then c.Cells(s, 14) = b.Cells(i, 3) End If Next s Next i Application.ScreenUpdating = True End Sub ワークシートcとワークシートbの1列目と2列目が一致したときにだけ、cの14列目にbの3列目のデータを代入したく思い、以上のようなコードを書きましたが、重くて終わる様子がありません。 ・そもそもあっているのか、あっていないならどこを修正すればよいか ・早く終わるようにするにはどうしたらいいか アドバイスをよろしくお願いします。
- 締切済み
- Visual Basic
お礼
解決しました。私のプログラムミスでした。 n = 9104 m = 48881 For k = 1 To n Worksheets("Sheet3").Cells(1 + Worksheets("Sheet1").Cells(k + m, 2), 1 + Worksheets("Sheet1").Cells(k + m, 4)-255) = Worksheets("Sheet1").Cells(k + m, 5) Next k この -255が抜けていました。これでうまくいったと思います。 どうもおさわがせしました。回答ありがとうございました。