- ベストアンサー
Excel 行番号を調べる
phoenix343の回答
- phoenix343
- ベストアンサー率15% (296/1946)
VBAでやるんだったら Findメソッド使うほうが早いし、よほどラクだよ？ Excel VBA 入門講座 (Find) http://excelvba.pc-users.net/fol7/7_1.html
関連するQ&A
- VBAで空白行を削除する
VBAでリストの空白行を削除するための適当なコードを探しているのですがどんぴしゃのものが中々見つかりません。ご教授下さい。 ブックBのシートBのリストにはA2～AN●まで値が入っています。 別のブックAからVBAで値を取り出し貼り付けています。 いくつかの方法を試しました。 (1)ブックを開いたときに空白行を削除 Sub Auto_Open() '空白行を削除 Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True End Sub 5分以上砂時計のままで結局終わりません。 強制終了させ再度ブックを開くと空白行は削除されているのですが、こんな動作では使うことができません。 (2)ブックAの値を貼り付けた後、空白行を削除し上書き保存する Sub エクスポート() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range(Cells(5, 7), Cells(79, 46)).Select Selection.Copy 'コピー Workbooks.Open Filename:="\\パス\ブックB.xlsm" '貼り付け先ファイルオープン Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '貼り付け Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True '空白行を削除 ActiveWorkbook.Save '上書き保存 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub (3)空白行を削除の部分は以下のコードも試しました Worksheets("SheetB").Range("A1").Select Set currentCell = Worksheets("sheetB").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If Not IsEmpty(currentCell) Then 'カレントセルが空白でなく、 If IsEmpty(nextCell) Then '次のセルが空白のとき nextCell.EntireRow.Delete End If End If Set currentCell = currentCell.Offset(1, 0) Loop '空白行削除 宜しくお願い致します。
- 締切済み
- Excel（エクセル）
- 配列のフリーズを解消してください。
Sub データ原本() Dim wsAll As Worksheet Set wsAll = Worksheets("All(5)") Dim lRow As Long, lCol As Long Dim i As Long, j As Long, cnt As Long With Worksheets("データ原本") '日付S行を日付に変更(「.」を「/」に置換) lRow = .Cells(Rows.Count, 1).End(xlUp).Row Dim MyArray As Variant MyArray = Range(.Cells(10, 1), .Cells(lRow, 1)) For i = 1 To lRow - 9 MyArray(i, 1) = Replace(MyArray(i, 1), ".", "/") Next Range(.Cells(10, 1), .Cells(lRow, 1)) = MyArray Erase MyArray '配列の初期化 '「天気」両サイドの &「内・外」両サイドの空白スペースを削除 lRow = .Cells(Rows.Count, 1).End(xlUp).Row MyArray = Range(.Cells(10, TNK), .Cells(lRow, TNK)) For i = 1 To lRow - 9 MyArray(i, 1) = Trim(MyArray(i, 1)) Next Range(.Cells(10, TNK), .Cells(lRow, TNK)) = MyArray Erase MyArray '配列の初期化 '数値0のデータ行の行削除 lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(9, Columns.Count).End(xlToLeft).Column Dim arr_A As Variant, arr_B As Variant arr_A = Range(.Cells(9, 1), .Cells(lRow, lCol)).Value ReDim arr_B(1 To lRow - 8, 1 To lCol) cnt = 0 For i = 1 To lRow - 8 If arr_A(i, 18) <> 0 Then cnt = cnt + 1 For j = 1 To lCol arr_B(cnt, j) = arr_A(i, j) Next j End If Next i .Range("A9").Resize(lRow, lCol).Value = arr_B End With End Sub 上記のコードを2回実行すると2回目には、 MyArray(i, 1) = Replace(MyArray(i, 1), ".", "/")のところで「型が一致しません。」とフリーズします。かと言って 「 '数値0のデータ行の行削除」コードを一括削除して、実行ボタンを何度押してもフリーズすることはありません。どこに不具合が生じているのかわからないのですが、どなたか名回答を宜しくお願いします。
- ベストアンサー
- Excel（エクセル）
- エクセルのマクロ
下記のマクロを実行するといつも.Findのところでフリーズしてしまいます。 同じ方法で違うBookからの取込には不具合はないのですが、何故だかわかりません。 ちょっと長くなりますが、どなたか教えてください。 'Function fn_KAKUNIN_Update(strSheetName As String, strInBookName As String) '変数宣言 Dim wksInSheet As Worksheet '入力シート Dim wkbInBook As Workbook '入力ブック Dim wksUpSheet As Worksheet '更新するシート Dim lngKAKUNIN_MaxRow As Long Dim lngSYACHO_MaxRow As Long Dim intMsg As Integer Dim strGenbaNo As String Dim i As Long Dim j As Long Dim rngFind As Range Dim lngStrNo As Long Set wkbInBook = Workbooks(strInBookName) Set wksInSheet = wkbInBook.Worksheets Set wksUpSheet = Workbooks（pstrBookName).Worksheets(strSheetName) fn_KAKUNIN_Update = 1 lngKAKUNIN_MaxRow = wksInSheet.Range("C4").CurrentRegion.Rows.Count lngSYACHO_MaxRow = wksUpSheet.Range("H4").CurrentRegion.Rows.Count lngStrNo = 4 For i = lngStrNo To lngSYACHO_MaxRow strGenbaNo = wksUpSheet.Range("H" & i) With wksInSheet.Range("C4:C" & lngKAKUNIN_MaxRow) Set rngFind = .Find(strGenbaNo, LookIn:=xlValues, MatchCase:=False) If rngFind Is Nothing Then Else
- 締切済み
- Visual Basic
- VBAで複数行の指定
ＶＢＡ教えてください 初心者です やりたい事 for next文を使用しbook1のシート内N~R行にある文字が入っていたなら book2のシート内のＢ行の文字を消すといった内容です 考えたコード sub test() dim c as variant dim i as long Set c = Workbooks("book2.xls").ActiveSheet With Workbooks("book1.xls").ActiveSheet For i = 1 To 100 If .Cells(i, 14) Like "*受入*" Then 'もし、14行目のセルのどれかに『受入』という文字が入っていたら c.Cells(i, 2).Clear 'その2行の条件に当てはまるセルをクリアする End If Next i End With end sub これではbook1のシートに内のＮ行しか反映されません 複数行Ｎ～Ｒに反映させるコードわからないです 教えてもらえるとすごく助かります。
- ベストアンサー
- Visual Basic
- VBA一定の範囲内からデータが入っている行を検索
現在VBAにて作成中です。 内容は、各シートの全く同じ範囲内から１シートへ自動で貼り付けを行い日付順に並べ替えるということです。 各シートは全て同じ表になっていますので、コピー範囲のセル番地は全シート同じです。 コピー範囲は、BF4：BM81で、BF4に日付が入っています。 81行までありますが、82行には、合計行が入っていることや、その下行もデータが入っている為、範囲指定をしています。また、81行設けていますが、上から順にデータは入っているものの、81行まで全て埋まっているとは限りません。 その為、下記のVBAにすると、各シートの81行までのデータが反映され１シートに全てのシート分が貼り付けられるので、かなりの行数になり、空白や0の行が出てしまいます。 範囲内から日付（列BF）のデータが入っている行までを検索し選択、貼り付けを行えるようにしたいと思っています。 どなたかご教授頂ければと思いますのでよろしくお願い致します。 見よう見まねで下記を作成しました。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow4 As Long Application.ScreenUpdating = False '----全データシートの有無をチェックします sh_check '----列見出しをコピーします Worksheets(2).Range("bf1:bm3").Copy Worksheets(1).Range("A1") For i = 2 To Worksheets.Count With Worksheets(i) 左上 = "Bf4" 右下 = "bm81" 範囲 = 左上 & ":" & 右下 lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(58, Columns.Count).End(xlToLeft).Column '----シートのデータが4行以上の場合にコピーします If lRow >= 4 Then lRow4 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 .Activate Range(範囲).Select Selection.Copy Worksheets(1).Cells(lRow4, 1).PasteSpecial Paste:=xlPasteValues End If End With Next i End Sub 説明に不足がありましたら、追って書き込みさせていただきます。
- 締切済み
- Visual Basic
- EXCEL コンボボックスのリスト設定
リストインデックスが複数ある場合は動くのですが、 インデックスが０ もしくは１個しかない場合は、どのように処理を追加したらいいでしょうか。。 実行時エラー381 Lisプロパティを設定できません。プロパティの配列のインデックスが無効です、と メッセージが出ます。 いろいろ試してるのですがわかりません。 コンボボックスの値は別シートで参照先を指定しています。 ----------- Private Sub ComboBox3_DropButtonClick() Dim lRow As Long Dim i As Long, myCnt As Long Dim myData With Worksheets("部門名") lRow = .Range("O" & Rows.Count).End(xlUp).Row ’O列の最終行を確認 myData = .Range("O2:O" & lRow).Value ’コンボボックスのリストデータ End With With ComboBox3 .ColumnCount = 1 .ColumnWidths = "50" .List = myData End With End Sub
- 締切済み
- Visual Basic
- Excel VBAで別ブックのマクロから配列を取る
Excel VBAで別ブックのマクロで計算した結果を配列で渡したいのですが、上手い方法が見つかりません。 同じブック内であれば、 Function GetAry(Imax As Integer, ByRef MyAry As Variant) as Boolean のような関数を作れば、GetAry = True の時に返値の MyAry が有効であるという判断ができますが、この関数を別ブックから使う場合は、参照渡しができません。 これはVBAの仕様なので仕方ないとして、以下のようなマクロを組んでみました。 '------------------------------------------------------- ' Book1.xlsm（呼び出される側） '------------------------------------------------------- Function MyAry(Imax As Integer) As Variant Dim i As Integer Dim SubAry() As Variant If Imax > 10 Then MyAry = False Else For i = 1 To Imax ReDim Preserve SubAry(i) SubAry(i) = i Next MyAry = SubAry End If End Function '------------------------------------------------------- ' Book2.xlsm（呼び出す側） '------------------------------------------------------- Sub GetMyAry() Dim DataAry As Variant Dim Imax As Integer Imax = 11 DataAry = Application.Run("Book1!MyAry", Imax) If DataAry <> False Then MsgBox UBound(DataAry) Else MsgBox DataAry End If End Sub '------------------------------------------------------- Imax = 11 であれば、メッセージボックスに False が表示されますが、Imax = 10 だと当然ですが「型が一致しません」というエラーになります。 エラートラップで誤魔化そうかとも思ったのですが、もっとスマートな方法がないでしょうか。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセル マクロで行削除のコードについての質問です
ある指定のセル範囲が空白ならその行自体を削除したいですが 上手くいきません。 記述したコードは以下の通りです。 Sub A01() Dim IRow As Long Dim d As Variant, i As Variant d = InputBox("抽出する日数を入力してください", "日数") If d = "" Then Exit Sub lRow = Cells(Rows.Count, 1).End(xlUp).Row For i = lRow To 2 Step -1 If ActiveSheet.Range(Cells(i, 5), Cells(i, d)) = Empty Then ActiveSheet.Rows(i).EntireRow.Delete End If Next End Sub Ifの判定の部分でエラーが出ます。 どう修正したらよいかご教示願います。
- ベストアンサー
- その他MS Office製品
- Excel マクロでL2から空白行までを各々コピー
Excel2003、OSはXPを使っています。 コピー元はブックAのL2からスタートして1行ずつをコピーし コピー先はブックBのC12からスタートして10行飛ばしでペーストする。 コピー元のL列に空白セルが来たらやめたいと考えています。 具体的には コピー元 -> コピー先 ブックA --> ブックB Sheet1 --> Sheet1 L2 ------> C12 L3 ------> C22 L4 ------> C32 ・ ・ コピー元に空白セルが来たらやめる といったイメージです。 初めてまだ3日程度なのでお恥ずかしいのですが、 以下のようなコードを作りましたが、a=の行で 「実行時エラー'9' インデックスが有効範囲にありません。」 と出てしまいます。 Dim a As Long Dim dc As Long Dim dct As Long a = Worksheets(bbk).Range("L2").End(xlDown).Rows '←実行時エラー'9' For dc = 2 To a For dct = 12 To dc + 10 Workbooks("ブックA.xls").Worksheets("Sheet1").Range("L" & dc).Copy _ Workbooks("ブックA.xls").).Worksheets("Sheet1").Range("C" & dct) Next dct Next dc 恐らく他にも悪いところはあるかと思いますが、 どうかご教授をおねがいします。
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA4行毎に枠で囲みたい
お世話になります。 添付の様な表1があります。 これを表2のようにA1から順に4行毎に枠で囲みたいのです。 下記のようなコードを見よう見まねで書いてみましたがうまく動きません。 ごなたかご教授いただけませんでしょうか？ よろしくお願い致します。 Dim i As Long Dim j As Long Dim lngYCnt As Long Dim intXCnt As Long Dim LastRow As Long ingYCnt = Worksheets("Sheet1").UsedRange.Rows.Count intXCnt = Worksheets("Sheet1").UsedRange.Columns.Count LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Selection For i = 5 To LastRow Range("A" & i & ":F" & j).Select Selection.BorderAround Weight:=xlMedium j = j + 5 i = i + 5 Next End With どなたかご教授いただけませんでしょうか？ よろしくお願い致します。 環境 EXCEL2003 ＷＩＮＤＯＷＳ XP SP3
- ベストアンサー
- その他MS Office製品
補足
やってみたのですが、 subプロシージャだと出来るのですが Functionプロシージャだと出来ないのですが 私のＰＣだけでしょうか？ Ｅｘｃｅｌ２０００だからかな～？？