• 締切済み

エクセルのマクロ

下記のマクロを実行するといつも.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

みんなの回答

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.1

最初に、関係ないところに目が行くのですが、なぜ、コメント表示になっているのでしょうか? こういうのは、通常、ユーザーファンクションではなくて、プロシージャですよね? 'Function fn_KAKUNIN_Update(strSheetName As String, strInBookName As String) そして、 >fn_KAKUNIN_Update = 1 これなんですか? だったら、再帰するにしても、まったく引数がないのですが、何かの間違いですか? どうなっているのでしょうか? 次に本題。 > Dim wksUpSheet As Worksheet '更新するシート として Set wksInSheet = wkbInBook.Worksheets With wksInSheet.Range("C4:C" & lngKAKUNIN_MaxRow) ワーク・シートコレクションを入れて、wkbinSheet に、Rangeオブジェクトで、Find メソッドが行けるのか、2002までのプロパティ・リストには出てきません。私の間違いかしら? >違うBookからの取込には不具合はないのですが、 そうなのでしょうか? >lngKAKUNIN_MaxRow = wksInSheet.Range("C4").CurrentRegion.Rows.Count >lngSYACHO_MaxRow = wksUpSheet.Range("H4").CurrentRegion.Rows.Count それと、これは、シートのデータ次第ですが、状況によって、取れないか、誤動作する可能性がありますね。最大行だと思いますが、そういう使い方よりも、Endプロパティのほうが確実ではないでしようか?

関連するQ&A

  • 教えて★ExcelでVBのマクロについて

    以前ここで質問させていただきました。 http://okwave.jp/qa3029622.html 上の内容のとおり教えていただきました。 マクロにさらにタイトルを追加したいのですが可能でしょうか? ファイルAのタイトルは5行目から始まり8行目まであります。 ファイルBのタイトルは2行目から始まり6行目まであります。 ★ファイルAのタイトルにファイルBのタイトルをつけ加えたい! 以下のソースに付け加えるとしたら、どこにどのように追加すればよいですか? 以上ですがよろしくお願いいたします。 Sub findJoin() On Error GoTo err Dim st1 As Worksheet Dim st2 As Worksheet Set st1 = ActiveSheet Workbooks.Open ("870xtd.xls") Set st2 = Workbooks("870xtd.xls").Sheets(1) Dim st1MaxRow As Long Dim st2Maxrow As Long st1MaxRow = st1.Cells(st1.Rows.Count, "A").End(xlUp).Row st2Maxrow = st2.Cells(st2.Rows.Count, "AB").End(xlUp).Row Dim R As Long For R = 2 To st1MaxRow Dim nmRng As Range Set nmRng = st2.Range("AB2:AP" & st2Maxrow).Find(st1.Cells(R, "A").Value, LookIn:=xlValues) If Not nmRng Is Nothing Then '発見した。 st2.Range("A" & nmRng.Row & ":AP" & nmRng.Row).Copy Destination:=st1.Range("DQ" & R) End If Next st1.Activate Set st1 = Nothing Set st2 = Nothing Exit Sub err: MsgBox Error End Sub

  • 隣のシートでのコピーのマクロ

    隣のシートでコピーをするマクロを作成しようとしたところ、エラーがでます。 具体的には、以下のようなマクロを作成したところ、 最後の、「 WC.Range(Rows(1), Rows(RowNum)).PasteSpecial」で、 「アプリケーション定義またはオブジェクト定義のエラーです」というメッセージがでてきます。 試しに、 WC.Range("a1").Select としても同様のエラーがでるので、 他のシートでのRangeの使い方に問題があるようだ、というのがわかるのですが、 具体的に何が問題で、どのように解決をしたらいいのかがわかりません。 よろしくお願い致します。 =====以下、マクロ===== Dim WA As Worksheet Dim WC As Worksheet Dim i As Integer Dim LastRow As Long Dim RowNum As Long i = ActiveSheet.Index Set WA = Worksheets(i) Set WC = Worksheets(i + 1) WC.Rows(1).Copy WC.Range(Rows(1), Rows(RowNum)).PasteSpecial

  • 複数のエクセルシートをまとめるマクロ

    下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub

  • 'Range'メソッドは失敗しました

    ExcelのVBAの質問になりますが、教えてください。 下記を動かすと最後の行で「'Range'メソッドは失敗しました: '_Worksheet' オブジェクト」と出ます どうしても最後の行をセレクトしたいのですが、どうしたらよいでしょうか。 Option Explicit Public WB1 As Workbook Public WB1SH1 As Worksheet Public CSVWB1 As Workbook Public CSVWB1SH1 As Worksheet Dim MaxRow As Integer Private Sub CommandButton1_Click() Set WB1 = ActiveWorkbook Set WB1SH1 = WB1.Worksheets(1) Dim a As String a = WB1SH1.Range("a1) Workbooks.Open "C:\Users\User\Desktop\" & a & ".CSV" Set CSVWB1 = ActiveWorkbook Set CSVWB1SH1 = CSVWB1.Worksheets(1) MaxRow = CSVWB1SH1.Cells(Rows.Count, 1).End(xlUp).Row WB1SH1.Activate WB1SH1.Range(Cells(1, 1), Cells(MaxRow, 3)).Select CSVWB1SH1.Activate CSVWB1SH1.Range(Cells(1, 1), Cells(MaxRow, 3)).Select  '←ここでエラーがでる End Sub

  • エクセルマクロで教えてください

    Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行 対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。

  • マクロ EXCELの範囲をコピーして貼付け

    『End(xlDown).Row』で取得した値を使ってセルの範囲指定&コピーを行い、 新しく追加したシートに貼り付けたいのですがうまくいきません。 Sub attendanceJoin() Dim MaxRow As Integer 'シートの最終行の値 Workbooks("test.xls").Activate Dim NewWorkSheet As Worksheet Set NewWorkSheet = Worksheets.Add() '新しいシートを追加する MaxRow = Worksheets(2).Range("M1").End(xlDown).Row  'A列の最終行を取得 NewWorkSheet.Name = "統合"  '新しく追加したシートの名前を変更 With Workbooks("test.xls") .Worksheets(2).Range("A1:M&MaxRow").Copy   'コピーするセルの範囲を指定    '↑ここでエラー。.Worksheets(2).Range("A1:M38").Copy を指定するイメージです。 .Worksheets("統合").Range("A1").PasteSpecial End With End Sub どなたか間違っている箇所のご教示お願い出来ますでしょうか。 どうぞよろしくお願い致します。

  • エクセル 同じ内容行削除マクロ 2

    シート1、シート2(基準)のB列を比較して同じ内容行を削除したいのですが、「栃木県3」と「#栃木県3」を同じのもと考えて削除されてしまいます。 Sub 削除()   Dim wh1     As Worksheet   Dim wh2     As Worksheet   Dim f      As Range   Dim wR     As Integer   Dim mR     As Long   Dim wStr    As String   '   Set wh1 = Worksheets("Sheet1")   Set wh2 = Worksheets("Sheet2")   wR = 0   With wh1     mR = .Cells(Rows.Count, "A").End(xlUp).Row     For wR = mR To 1 Step -1       wStr = .Cells(wR, "B")       Set f = wh2.Range("B1:B" & wh2.Cells(Rows.Count, "B").End(xlUp).Row).Find(wStr)       If Not f Is Nothing Then         .Rows(wR).Delete       End If     Next   End With End Sub 解決策教えて下さい。

  • エクセル 何故かシート間の値のコピーが出来ない

    いつもお世話になります。 開いているブックのシート「リスト1~3」に、Book1.xlsの「リスト1~3」の値をコピーする為に、下記のマクロを作成しました。 Dim SH1, SH2, SH3, SH4, SH5, SH6 As Worksheet Set SH1 = ThisWorkbook.Worksheets("リスト1") Set SH2 = ThisWorkbook.Worksheets("リスト2") Set SH3 = ThisWorkbook.Worksheets("リスト3") Set SH4 = Workbooks("Book1.xls").Worksheets("リスト1") Set SH5 = Workbooks("Book1.xls").Worksheets("リスト2") Set SH6 = Workbooks("Book1.xls").Worksheets("リスト3") 'リスト1をコピーする D = SH4.Range("A1").CurrentRegion.Rows.Count E = SH4.Range("A1").CurrentRegion.Columns.Count SH1.Range(Cells(1, 1), Cells(D, E)).Value = SH4.Range("A1").CurrentRegion.Value 'リスト2をコピーする F = SH5.Range("A1").CurrentRegion.Rows.Count G = SH5.Range("A1").CurrentRegion.Columns.Count SH2.Range(Cells(1, 1), Cells(F, G)).Value = SH5.Range("A1").CurrentRegion.Value 'リスト3をコピーする H = SH6.Range("A1").CurrentRegion.Rows.Count I = SH6.Range("A1").CurrentRegion.Columns.Count SH3.Range(Cells(1, 1), Cells(H, I)).Value = SH6.Range("A1").CurrentRegion.Value 以上を実行すると、「アプリケーション定義またはオブジェクト定義のエラーです」とエラーメッセージが出てしまいます。 それぞれのシートの処理の時に、 SH1.Select SH2.Select SH3.Select を入れて、シートを選択してから実行すると問題なく動くのですが、何故このようなことが起こるのでしょう?

  • 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列目のデータを代入したく思い、以上のようなコードを書きましたが、重くて終わる様子がありません。 ・そもそもあっているのか、あっていないならどこを修正すればよいか ・早く終わるようにするにはどうしたらいいか アドバイスをよろしくお願いします。

  • エクセルVBA!(COPY) Win2000,offce2000

    単純な質問かもしれませんが、 WorkBooks("test")から 別のWorkBooks("Data").WorkSheets("Sheet1")のデータの数を判定して全てをコピーして、 WorkBooks("test")のWorkSheets("Sheet2")へペーストしたいのですが、うまくいきません ↓のような感じです。 Dim wstest As Worksheet Dim wsData As Worksheet Dim wsNM As String Dim Drow As Long Sub copy() 'DataSheetのSheet名がその都度違うので、取得しました。 wsNM = wsData.Sheets(1).Name Set wsData = Workbooks("Data.xls").Worksheets(wsNM) Set wsTest = Workbooks("Test.xls").WorkSheets("Sheet2") 'データの範囲判定 Drow = wsData.Range("H65536").End(xlUp).Row '/////// ここからが???です /////// wsDataのA1からBAのDrowを範囲を指定して、Copy → wsTestのA1に貼り付けたいのですが、どうしたらよいのでしょうか? コピーしたり、直接書くようにしたりといろいろなコードを書いてみましたがダメでした。 Cellsで範囲をとる方法がわかりません。Rangeなら(A1:BA300)のように取れる範囲もCellsの時はどうしたらよいのでしょうか?(そのまま書けば、Cells(1,1):Cells(Drow,53)みたいな・・・・・) と、悩んでいるより一気にコピーするのもどうかと思いFor~Nextで1行ずつ書いていったらどうかとも考えましたが、うまくいきませんでした。 End Sub ※ Drowは、6000~20000 よろしくお願いします。

専門家に質問してみよう