最大行数を取得するVBAコードとは？
- 人生で初めてエクセルのマクロに挑戦してみた。が、《最大行数を取得するVBAコード》で躓いた。２時間ばかり、悪戦苦闘したがサッパリ判らない。苦肉の策で、SQL文を使った。でも、それじゃー解決したことにはならない。
- VBA初心者の方がエクセルのマクロを使って最大行数を取得する方法について困っています。試行錯誤した結果、SQL文を使用する方法も試しましたが、うまくいきませんでした。みなさんはどのようなコードを使って最大行数を取得していますか？教えていただけると助かります。
- エクセルのVBAで最大行数を取得する方法について質問です。初めてマクロに挑戦してみたのですが、最大行数を取得するVBAコードがわかりません。SQL文を使った方法も試しましたが、うまくいきませんでした。みなさんはどのようなコードを使って最大行数を取得していますか？よろしくお願いします。
- ベストアンサー
最大行数を取得するVBAコードとは？
人生で初めてエクセルのマクロに挑戦してみた。が、《最大行数を取得するVBAコード》で躓いた。２時間ばかり、悪戦苦闘したがサッパリ判らない。苦肉の策で、SQL文を使った。でも、それじゃー解決したことにはならない。 Public Sub Do_XferPer() Dim I As Integer Dim N As Integer Application.ScreenUpdating = False ' ' 先頭行の取得 ' N = DLookup("SELECT COUNT(*) FROM [Sheet3$A:A1000]") - 1 Debug.Print N For I = 2 To N If 0 Then Cells(I, 1) = XferPer(Cells(I, 1)) End If Next I Application.ScreenUpdating = True With ThisWorkbook.Worksheets("Sheet3").UsedRange N = .Rows.Count - 1 Debug.Print N End With With Range("A1").SpecialCells(xlLastCell) N = .Row - 1 Debug.Print N End With End Sub 【質問】 みなさんは、最大行数を取得するのにどのようなコードを書かれていますか？ 宜しくお願いします。
- 山田 太郎（@f_a_007）
- お礼率71% (25/35)
- Excel（エクセル）
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- コントロールのタイプを取得したい場合
Sub test() Dim i As Integer Dim StrFormName As String StrFormName = "UserForm1" With UserForms.Add(StrFormName).Controls For i = 0 To .Count - 1 Debug.Print .Item(i).Name Next End With End Sub これでエクセルのユーザーフォーム上のすべてのコントロール名が取得できるのですが、 コントロールのタイプを取得したい場合、 Debug.Print .Item(i).Name の部分をどう変えればいいのでしょうか？ 例えばコマンドボタンなら、「CommandButton」と返ってきてほしいです。 Debug.Print .Item(i).Controlstype でも Debug.Print .Item(i).Controltype でもエラーになりました。
- ベストアンサー
- Excel（エクセル）
- VBAでの質問
お世話になります。 下記の記述で、「←」の矢印の記述で、 Cells.（５，２）がブランクでなければ、 「→」から進めたいのですが、 どの様に記述すれば宜しいでしょうか ご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3) ← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub
- ベストアンサー
- Visual Basic
- VBA 重たいためコード改善お願いします
ＶＢＡ歴３か月の学習者です。 セルに入力された行数をもとに、セル範囲を決め、シートＸＹにコピペをするコードを作りました。 コード自体は、思い通りに動いていますが、１０００回程度のループ処理を考えており、すべて終わるのに１時間程度かかってしまっています。 よろしければ、下記コード内で、時間を短縮できる編集のアドバイスをお願いいたします。 Sub test() Dim i, LastR, TopR, BottomR, myRow As Long Dim SheetD, SheetX, SheetY, SheetSu, mySheet As Worksheet Dim ColumnF, ColumnL, n As String Dim ResultRange As Range Application.ScreenUpdating = False Set SheetD = Sheets("D") Set SheetX = Sheets("X") Set SheetY = Sheets("Y") Set SheetSu = Sheets("Sum") Set ResultRange = SheetSu.Range("Z6:BT6") ColumnF = "A" ColumnL = "M" LastR = SheetD.Range(ColumnF & Rows.Count).End(xlUp).Row TopR = 2 i = 2 Do Until SheetD.Cells(i, "X") = "" And SheetD.Cells(i, "Y") = "" If SheetD.Cells(i, "X") = "" Or SheetD.Cells(i, "Y") = "" Then i = i + 1 Else With SheetD TopR = .Cells(i, "X").Value BottomR = .Range("B" & TopR).End(xlDown).Row .Range(ColumnF & TopR & ":" & ColumnL & BottomR).Copy End With With SheetX .Columns(ColumnF & ":" & ColumnL).ClearContents .Range("B1").PasteSpecial Paste:=xlPasteValues End With With SheetD TopR = .Cells(i, "Y").Value BottomR = .Range("B" & TopR).End(xlDown).Row .Range(ColumnF & TopR & ":" & ColumnL & BottomR).Copy End With With SheetY .Columns(ColumnF & ":" & ColumnL).ClearContents .Range("B1").PasteSpecial Paste:=xlPasteValues End With ResultRange.Offset(Cells(Rows.Count, "Z").End(xlUp).Row - 5).Value = ResultRange.Value i = i + 1 End If Loop Application.CutCopyMode = False SheetX.Columns(ColumnF & ":" & ColumnL).ClearContents SheetY.Columns(ColumnF & ":" & ColumnL).ClearContents Application.ScreenUpdating = True MsgBox "Finish" End Sub
- 締切済み
- Excel（エクセル）
- EXCEL VBAでHPageBreaks
いつもお世話様です。 こちらで教えていただいたマクロでフッダーの前に自動で罫線を引こうとしています。 前の質問は→http://okweb.jp/kotaeru.php3?q=1310420 下記のマクロを動かすと、１ページだけの時はちゃんとフッダーの上に罫線が引けますが、2ページ目になると「インデックスが有効範囲にありません」という実行時エラーが出てしまいます。 どこがいけないのでしょうか？ Sub 自動罫線TEST() Dim BreakSu As Integer Dim BreakSu2 As Integer Dim B As Integer Dim Rw As Long Dim LastRow As Long For N = 1 To 3 With Cells .ClearContents .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With Range("A1:D" & N * 30) = N & N & N 'TESTデータ挿入 LastRow = Range("A65536").End(xlUp).Row '最終行取得 BreakSu = ActiveSheet.HPageBreaks.Count '改ページ数取得 Range(Cells(LastRow + 1, "A"), Cells(LastRow + 100, "A")) = "ABC" '改ページ数を増やすダミー BreakSu2 = ActiveSheet.HPageBreaks.Count '増えた改ページ数取得 For B = 1 To BreakSu + 1 ' MsgBox B & "-" & BreakSu + 1 & "-" & BreakSu2 Rw = ActiveSheet.HPageBreaks(B).Location.Row - 1 '改ページ前行取得（ここでエラー！） With Range(Cells(Rw, "A"), Cells(Rw, "D")).Borders(xlEdgeBottom) '改ページ前罫線挿入 .LineStyle = xlContinuous End With Next B Range(Cells(LastRow + 1, "A"), Cells(LastRow + 100, "A")) = ClearContents 'ダミー消去 ActiveSheet.PrintPreview Next End Sub
- ベストアンサー
- オフィス系ソフト
- シート上のOLEオブジェクトのタイプを取得する
シート上のOLEオブジェクトのタイプを取得するｖｂａは？ Sub Sample() Dim i As Integer For i = 1 To ActiveSheet.OLEObjects.Count Debug.Print ActiveSheet.OLEObjects(i).Type Next i End Sub これだとエラーになります。 テキストボックスとかコマンドボタンとかの情報を取得するには どうすればいいでしょうか？
- ベストアンサー
- その他MS Office製品
- ｛アクセス｝全てのフォームの名前を取得したい
ひとつのＭＤＢファイルに入っている全てのフォームの名前を取得したいのですが Sub 全てのフォームの名前を取得() Dim i As Integer For i = 1 To Forms.Count Debug.Print Forms.Name Next End Sub このコードだと オブジェクトは、このプロパティまたはメソッドをサポートしていません。(Error 438) となってしまいます。 どうすればいいでしょうか よろしくお願い致します。
- ベストアンサー
- Visual Basic
- VBA のコードについて
すみません、以前にも同じようなご質問をさせて頂いたのですが、どうしても以下のマクロがうまく機能しません。 新しいブックは作成されるのですが、End If以降の検索結果が反映（コビー）されません。 コードに問題があるかアドバイス頂けますと幸いです。 どうぞ宜しくお願いいたします。 Sub sort() Dim i As Long Dim grp As String Dim newBookName As String Dim newBookPath As String Dim newBook As Workbook For i = 2 To 4 LOB = Workbooks("test").Worksheets("grpリスト").Cells(i, 2) newBookName = Workbooks("test").Worksheets("grpリスト").Cells(i, 2) & ".xlsx" newBookPath = ThisWorkbook.Path & "\" & newBookName '指定したパスにファイルが作成済でないかを確認。 If Dir(newBookPath) = "" Then '新しいファイルを作成 Set newBook = Workbooks.Add '新しいファイルをVBAを実行したファイルと同じフォルダ保存 newBook.SaveAs newBookPath Else '既に同名のファイルが存在する場合はメッセージを表示 MsgBox "既に" & newBookName & "というファイルは存在します。" End If With Workbooks("test").Worksheets("マスタ0701").AutoFilterMode = False With .Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)) .AutoFilter Field:=13, Criteria1:=grp '.CurrentRegion.Select Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)).SpecialCells(xlVisible).copy Workbooks(grp).Worksheets("Sheet1").Range("A1") '.AutoFilter End With End With Next i End Sub
- ベストアンサー
- Visual Basic
- VBA セルの値を取得する
下記のはランダムにチーム分けするものです。 TmCnt = 5がチーム数です。 Sub Sample() Dim Total As Integer Dim TmCnt As Integer Dim Data1 As Variant Dim Data2() As String Dim i As Integer, j As Integer, k As Integer Total = Cells(Rows.Count, 1).End(xlUp).Row TmCnt = 5 Data1 = Range("A1:A" & Total).Value ReDim Data2(1 To Total) Randomize For i = TmCnt To 1 Step -1 j = Int(Rnd * i) + 1 Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i For i = Total To TmCnt + 1 Step -1 j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1) Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i i = 1 Do For j = 1 To TmCnt k = k + 1 Cells(i, j + 2).Value = Data2(k) If k = Total Then Exit Sub Next j i = i + 1 Loop End Sub TmCnt = 5をセル「B1」にチーム数を入力し、（例「6」「4」など）マクロを実行したいのです。 検索しましたところ、 セルの値を取得するにはRange("A1").Valueを入力だそうです。 TmCnt = 5を下記に書き換えるにはどのようにしたら良いでしょうか？ Dim s As String s = Range(“B1”).Value Debug.Print(s) 宜しくお願いします。
- ベストアンサー
- Visual Basic
- VBAコードでシート名を取得したい。
下記のコードは、指定したExcelブックにある情報をVBAコードを設置したブックに 情報を取得するコードになります。 質問なんですが・・・指定したExcelブックは、予めSheet名までをVBAコードで指定し、 そのSheetの内容を取得していますが、この部分を指定したSheet名ではなく、 Sheet名を取得し、取得したSheet名から自分で選択したSheetを選んび、 そのSheetの内容を取得する様に変えたいと考えています。 取得する側のSheet名が一定の名前になっていない為、 今までSheet名を変えて情報を取得する様にしていたのを 変えずに情報を取得したいと思ったからなんですが・・・ どの様に変えればできるのか初心者のためよろしくお願いします。 できましたら・・・UserForm2を使ってComboboxに取得するSheet名を 一覧化し、そのComboboxからSheet名を選べる様にしたいと思います。 ----------------------------------------------------------------------------------- Public Day As String '全プロシージャーで有効な変数 Sub CommandButton1() If MsgBox(Space(6) & "メールデータを取込みます。よろしいですか？", vbYesNo, "継続確認") = 7 Then Exit Sub Dim LstWb As Workbook Dim LstWs As Worksheet Dim OutWs As Worksheet Dim LstDt As Variant Dim EndRow As Long Dim Day0 As String Dim Day1 As String Dim i As Long Dim j As Integer Dim k As Long Set LstWb = Workbooks.Open(ThisWorkbook.Path & "\テストファイル.xlsm") Set OutWs = ThisWorkbook.Sheets("Sheet1") Set LstWs = LstWb.Sheets("Sheet1") EndRow = LstWs.Cells(Rows.Count, 1).End(xlUp).Row With LstWs LstDt = .Range(.Cells(1, 1), .Cells(EndRow, 5)) End With LstWb.Close Set LstWb = Nothing Set LstWs = Nothing Load UserForm2 With UserForm2 Day0 = LstDt(2, 4) .ComboBox1.AddItem Day0 For i = 2 To EndRow With .ComboBox1 Day0 = .List(.ListCount - 1) Day1 = LstDt(i, 4) If Day0 <> Day1 Then .AddItem Day1 End If End With Next i .ComboBox1.Value = .ComboBox1.List(0) End With UserForm2.Show For i = 1 To 5 OutWs.Cells(1, i).Value = LstDt(1, i) Next i k = 2 For i = 2 To EndRow Day0 = LstDt(i, 4) If Day = Day0 Then For j = 1 To 5 OutWs.Cells(k, j).Value = LstDt(i, j) Next j k = k + 1 End If Next i Set OutWs = Nothing LstDt = Empty UserForm1.Show (vbModeless)End Sub
- ベストアンサー
- Visual Basic
- 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
お礼
完全に勘違いしていました。 ＞見出しも勘定するのはエクセルでは当たり前。 このことを失念していました。あらためて、申しあげます。