エクセルの学校：全文検索：Hyper Estraier： VBA 強制終了

Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)

vba (14723), 強制終了 (237)

[[20130515142738]]: #score: 16176; @digest: 3b26bbac78ecdef7a07aaaf8d3e09ef8; @id: 62336; @mdate: 2013-05-15T07:19:29Z; @size: 6730; @type: text/plain; #keywords: 規リ (50119), foundcell (47430), firstcell (40561), b1001 (28032), landisk (25454), 覧. (22949), findformat (22145), 社¥ (18894), 色7 (15022), タ¥ (14426), share (10227), 納se (9972), ト一 (7555), searchformat (7362), 定' (5814), 事態 (3597), 景色 (3200), 終セ (3137), ピン (2920), 背景 (2412), 格納 (2379), 見つ (2229), 期化 (1892), に格 (1752), xlsm (1577), 新規 (1499), 〜e (1499), 一覧 (1498), 索条 (1394), what (1386), ドレ (1306), address (1265); 『塗りつぶしセルのデータを別ブックにコピーする』（YE）
Excel2010,Windows 7を使用しています。 B列にある塗りつぶしセルを検索し、見つかった塗りつぶしセルのあるA〜E列のデータを順次別のブックにコピーペーストしていきたいのですが、下記VBAを実行したところ、何のエラーも表示されず、待ち状態（検索中?）のまま動かずブックも閉じれなくなりました。 強制終了してログオフできましたが、どこがおかしかったのでしょうか? 又、このような事態になった場合、どうすれば良いでしょうか? VBA初心者の為、詳しく教えていただけるとありがたいです。 Dim FoundCell As Range, FirstCell As Range Application.FindFormat.Clear '初期化 Application.FindFormat.Interior.ColorIndex = 7 'セルの書式の検索条件は背景色7（ピンク）に設定 'B6〜B1001内でピンクの背景色のセルをFoundCellに格納 Set FoundCell = Range("B6:B1001").Find(What:="*", SearchFormat:=True) If FoundCell Is Nothing Then '見つからなければ MsgBox "見つかりませんでした" '「見つかりませんでした」と表示 Exit Sub Else 'そうでなければ（見つかれば） Workbooks.Open Filename:="¥¥LANDISK¥share¥会社¥データ¥新規リスト一覧.xlsm" Set FirstCell=FoundCell '見つかったセルはFirstCellに格納 '見つかったセルのA〜E列をシート1の最終セルの1つ下のセルへコピーする FoundCell.Resize(1, 5).Copy Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Do '次に探して見つかったセルをFoundCellに格納 Set FoundCell = Range("B6:B1001").Find(What:="*", After:=FoundCell, SearchFormat:=True) If FoundCell Is Nothing Then MsgBox "見つかりませんでした" Exit Do Else FoundCell.Resize(1, 5).Copy Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If 'FoundCellのアドレスと最初に見つかったアドレスが同じになるまで繰り返す Loop Until FoundCell.Address = FirstCell.Address End Sub ---- まず、検索しようとしているシートは、どのブックの、どのシート? また、結果を書き込もうとしているシートは、どのブックのどのシート? アップされたコードでは、・まず、最初に、マクロ実行時のアクティブシートに対してFind。・そのあと、新規リスト一覧.xlsm を開くので、この時点でアクティブシートは新規リスト一覧.xlsmでたまたま、開いたときにアクティブなシートになる。・で、このシートにたいして Set FoundCell = Range("B6:B1001").Find(・・つまり、最初にFindをかけたシートと、明らかに異なるブックの異なるシートに対してFindをかけているね。ここが、根本的におかしいね。新規リスト一覧.xlsm って何? (ぶらっと) ---- 原因は既にぶらっとさんから説明があるので、修正版の提示だけ。 (Mook) Sub Sample() Dim srcWS As Worksheet Set srcWS = ActiveSheet Dim FoundCell As Range, FirstCell As Range Application.FindFormat.Clear '初期化 Application.FindFormat.Interior.ColorIndex = 7 'セルの書式の検索条件は背景色7（ピンク）に設定 'B6〜B1001内でピンクの背景色のセルをFoundCellに格納 Set FoundCell = srcWS.Range("B6:B1001").Find(What:="*", SearchFormat:=True) If FoundCell Is Nothing Then '見つからなければ MsgBox "見つかりませんでした" '「見つかりませんでした」と表示 Exit Sub End If Dim dstWS As Worksheet Set dstWS = Workbooks.Open(Filename:="¥¥LANDISK¥share¥会社¥データ¥新規リスト一覧.xlsm").Worksheets("Sheet1") '見つかったセルのA〜E列をシート1の最終セルの1つ下のセルへコピーする Set FirstCell = FoundCell '見つかったセルはFirstCellに格納 Do FoundCell.Resize(1, 5).Copy dstWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Set FoundCell = srcWS.Range("B6:B1001").Find(What:="*", After:=FoundCell, SearchFormat:=True) Loop Until FoundCell.Address = FirstCell.Address End Sub ---- Mookさんからコードがでているんだけど、書いたので。（ほとんど同じ）なお、Application.FindFormat.Clear '初期化これは、最初は不要かな? それより、最後に、後始末としていれておいたほうがいいね。あと、細かいところだけど、仮に B6 がピンク色塗りセルの場合、現行コードでは、このB6 が一番最後に転記されてしまうのでちょっとだけ、チューニング。 Sub Sample() Dim FoundCell As Range, FirstCell As Range Dim mySh As Worksheet Dim toSh As Worksheet Dim myR As Range Set mySh = ThisWorkbook.Sheets("Sheet1") '検索対象シート Set myR = mySh.Range("B6:B1001") Application.FindFormat.Interior.ColorIndex = 7 'セルの書式の検索条件は背景色7（ピンク）に設定 'B6〜B1001内でピンクの背景色のセルをFoundCellに格納 Set FoundCell = myR.Find(What:="*", After:=myR.Cells(myR.Count), SearchFormat:=True) If FoundCell Is Nothing Then '見つからなければ MsgBox "見つかりませんでした" '「見つかりませんでした」と表示 Else 'そうでなければ（見つかれば） Set toSh = Workbooks.Open("¥¥LANDISK¥share¥会社¥データ¥新規リスト一覧.xlsm").Sheets(1) Set FirstCell = FoundCell '見つかったセルはFirstCellに格納 Do '見つかったセルのA〜E列をシート1の最終セルの1つ下のセルへコピーする FoundCell.Resize(1, 5).Copy toSh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) '次に探して見つかったセルをFoundCellに格納 Set FoundCell = myR.Find(What:="*", After:=FoundCell, SearchFormat:=True) 'FoundCellのアドレスと最初に見つかったアドレスが同じになるまで繰り返す Loop Until FoundCell.Address = FirstCell.Address End If Application.FindFormat.Clear 'リセット End Sub (ぶらっと) ---- ぶらっとさんいつも早速のお返事ありがとうございます!! よくよく見なおしてみるとなるほど、どのブックのどのシートか明示していませんでしたね!! それでたまたまアクティブになったシートに検索をかけることになり、見つからず...あのおそろしい事態に... しかも今私がじっくり見返して返信を打ち込んでいる間にMookさんまで!! さすが皆さんお早いです!!いつもわかりやすく教えていただいて本当にありがとうございます!! 検索しようとしているシートは...¥¥LANDISK¥share¥会社¥検索¥検索一覧.xlsm 結果を書き込もうとしているシートは...¥¥LANDISK¥share¥会社¥データ¥新規リスト一覧.xlsm です。今からもう一度皆さんにいただいたお返事を勉強させていただきます!! ちなみに...またあの恐ろしい事態になった場合、やはり強制終了でよかったのでしょうか? （YE) ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/201305/20130515142738.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ