- ベストアンサー
エクセルＶＢＡ（ＬＯＯＫＵＰ関数）Ｗｉｎ2000、Ｏｆｆｉｃｅ2000
nishi6の回答
＞どの辺りをいじればいいのでしょうか イレギュラーなので、１列毎に書くべきでしょう。 補足にD列がない？下はB、D列は書き込んでいません。 'データシートの値を集計表に書く For Col = 1 To 45 If Not (Col = 2 Or Col = 4) Then Select Case Col Case 1: pCol = 3 '集計表A列=データシートC列 Case 3: pCol = 9 '集計表C列=データシートI列 Case 5: pCol = 16 '集計表E列=データシートP列 Case 6: pCol = 17 '集計表F列=データシートQ列 Case 7: pCol = 6 '集計表G列=データシートF列 Case 8: pCol = 12 '集計表H列=データシートL列 Case 9: pCol = 13 '集計表I列=データシートM列 '集計表J列=データシートR列、8列ずれ Case 10 To 45: pCol = Col + 8 End Select wsS.Cells(Rw, Col) = wsD.Cells(fRw, pCol) End If Next
関連するQ&A
- エクセルVBAでLOOKUP関数がうまくできません
エクセルVBAでLOOKUP関数がうまくできません。 入力シートと判別用のシートがあり入力シートで入力した品名を検索値 として判別用シートで数値に置き換えた値をLOOKUPで検索したいのですが WorksheetFunctionクラスのVLOOKUPプロパティを取得できませんと 実行時エラーが出ます。検索しましたが修正方法がわかりません。 構文のどこが原因なのか教えてください。 VBA初心者です。よろしくお願いします。 sub test() Dim データ行 As Long Dim データ数 As Long データ行 = Cells(Rows.Count,8).End(xlUp).Row For データ数 = 11 To データ行 Cells(データ数 ,32) = Application.WorksheetFunction.VLookup(cells(データ数,8),Worksheets("判別シート").Range("B11:E110"),5,False) Next データ数 End sub
- ベストアンサー
- その他([技術者向] コンピューター)
- 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について
前回質問させていただきました件の追加機能になります。以前質問させていただきましたマクロが下記のものです。 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; 複数のループ処理
↓のようなコードがあります。 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
- エクセル関数をVBAでやりたい
IFERROR(INDEX(***,MATCH(***)),"")この式を下記マクロに組み込むことは、可能でしょうか？ Sub Macro1() ' Dim line3 As Integer Dim line5 As Integer line5 = 2 '初期値を２行目に設定してます Do While Worksheets("Sheet5").Cells(line5, 1).Value > 0 'sheet5の通し番号をsheet3のH列から検索して、その行数をline3に代入する。 line3 = Worksheets("Sheet3").Range("H:H").Find(what:=Worksheets("Sheet5").Cells(line5, 8)）.Row 'A,B列内容のコピー Worksheets("Sheet5").Range("A" & line5, "B" & line5).Copy Worksheets("Sheet3").Cells(line3, 1) 'D～G列内容のコピー Worksheets("Sheet5").Range("D" & line5, "G" & line5).Copy Worksheets("Sheet3").Cells(line3, 4) line5 = line5 + 1 '次の行へ Loop （ http://soudan1.biglobe.ne.jp/qa8921867.html ）
- ベストアンサー
- Visual Basic
- エクセル2019 VBAについて
エクセル2019でVBAを使いコピーペーストの勉強中です、次の箇所(Dim i As integr)で、ユーザー定義型は定義されていませんと指摘されて止まってしまします、Sheet("データ")には3行のデータは入っています、VBA初心者のため、この後が、なかなか前に進めません、どうかよろしくおねがいします。 ********************************** Sub 練習() Dim s1 As Worksheet: Set s1 = Worksheets("請求書") Dim s2 As Worksheet: Set s2 = Worksheets("データ") Dim r1 As Integer: r1 = 18 Dim r2 As Integer: r2 = 2 { Dim i As integr } For i = 0 To 2 s1.Range(s1.Cells(r1 + i, 1), s1.Cells(r1 + i, 3)).Value = s2.Range(s2.Cells(r2 + i, 2), s2.Cells(r2 + i, 4)).Value s1.Cells(r1 + i, 4).Value = s1.sells(r1 + i, 2).Value * s1.Cells(r1 + i, 3).Value Next End Sub ***************************************
- ベストアンサー
- Excel（エクセル）
- 全くの初心者ですVBA
どこが悪いかわかりません。 教えてください。 Sub テスト() Dim kekka As String Dim i As Integer tokuten = Worksheets("Sheet1").Cells(i, 1).Value For i = 1 To Worksheets("Sheet1").Range("A1").End(xlDown).Row.Count If tokuten >= 80 Then kekka = "合格" Else kekka = "不合格" kekka = Cells(i, 2) End If Next i End Sub シート１の A列に数値で得点が入っています。
- ベストアンサー
- その他（プログラミング・開発）
- 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でDcount関数がうまく動きません。
EXCELのVBAでDcount関数を使おうとして、下記コードを作成しましたが、Dcount関数の部分が期待どおり動かず、該当なしとして、０を返してきます。 デバックで途中でマクロを止めて(Dcount関数の前)、セルに直接Dcount関数を入力すると、期待どおりの値を返してきます。 Dcount関数の記述の何が問題なのか、ご教示いただければ幸いです。 Sub 期間集計() Dim myrow, Krow As Double Dim First, Last As Date Dim i, Count As Integer Dim Data As Integer Dim Keria As String 'Worksheets("期間別").Activate Worksheets("期間別").Range("A1:BB65536").Delete Worksheets("入力").Activate With Worksheets("入力") '入力表の最終行の行数をmyrowに代入 myrow = .Range("A65536").End(xlUp).Offset(1).Row '出力前に入力データを日付順にソート .Range("A3").Sort _ Key1:=.Columns("A"), _ Header:=xlGuess First = Worksheets("集計").Range("G3") Last = Worksheets("集計").Range("H3") .Range("BH3:BH5").ClearContents .Range("BH3") = "日付" .Range("bi3") = "日付" .Range("BH4") = ">=" & First .Range("BI4") = "<=" & Last .Range(.Cells(2, 1), Cells(myrow, 47)).AdvancedFilter Action:=xlFilterCopy, _ Criteriarange:=.Range("BH3:BI4"), Copytorange:=Worksheets("期間別").Range("C11"), Unique:=False Krow = Worksheets("期間別").Range("C65536").End(xlUp).Row Keria = "C11:" & "AW" & Krow End With Worksheets("集計").Activate With Worksheets("集計") .Range(.Cells(13, 10), .Cells(24, 10)).ClearContents For i = 1 To 12 Count = 12 + i .Range(.Cells(Count, 16), .Cells(Count, 61)).Copy .Range(.Cells(11, 16), .Cells(11, 61)).PasteSpecial Paste:=xlValues .Range(.Cells(10, 16), .Cells(11, 61)).Copy With Worksheets("期間別") .Range(.Cells(11, 53), .Cells(12, 98)).PasteSpecial Paste:=xlValues Data = WorksheetFunction.DCount(.Range(Keria), .Range("C11"), .Range("BA11:CT12")) End With .Cells(Count, 10) = Data Next i End With
- ベストアンサー
- オフィス系ソフト
補足
nishi６さん！ありがとうございました。 やはり、1行づつで良かったのですね。試しにしてみたらうまくはいったもののほんとにこれで良いのか・・・と不安だったもので・・・ これは、いろいろと使えそうです。大変助かりました。少しだけ仕組みが分かりました。後の今回分からなかったとこは勉強していきたいと思います。本当にありがとうございました。