Results of 1 - 1 of about 37697 for IF (0.007 sec.)
- [[20061024211146]]
- #score: 1591
- @digest: 612475ca3503961e46add86dd3ddd066
- @id: 26137
- @mdate: 2006-10-27T03:45:13Z
- @size: 8495
- @type: text/plain
- #keywords: 調書 (65431), 了調 (56859), 能調 (46132), book5 (39263), book4 (29556), sl567 (22862), flg4 (13096), tbl1 (12779), 〜bo (12640), tbl2 (12492), dic1 (10428), 複" (10249), dic2 (9324), 書") (8117), 不能 (8026), flg2 (7129), book3 (6868), book1 (4136), myfile (3268), workbooks (3099), interior (3095), colorindex (2546), book2 (2490), 書と (2420), isempty (2288), 完了 (2284), thisworkbook (1918), scripting (1600), boolean (1378), sheets (1361), 重複 (1330), exists (1301)
- 『重複を検索表示』（SL567）
1つのフォルダーの中にBooK1:BooK2:BooK3:BooK4:BooK5の5個のシートがあります。 BooK1〜BooK4までのO列に入力した数字&文字をBooK5のA列に表示させてBooK5のA列で重複があれば色を付けてあらわしたいのですが?また、BooK5のB列に重複ありと表示できれば最高です。 現在はBooK1〜BooK4でO列で入力したものをBooK5のA列に貼り付けて=COUNTIF(A:A,A1000)>1の条件書式で行っています。時間が掛かるしコピーを忘れたりして大変です。。 （BooK1:BooK2:BooK3:BooK4のO列には空白箇所もあります） 無理でしょうか? ---- それぞれのBookのSheet名はなんでしょうか? (ROUGE) ---- ありがとうございます。Sheet名はBooK1〜BooK5まで完了調書と不能調書と言う名前を（2シート）使用しています。よろしくお願い致します。 （SL567） ---- スマートなコードではありませんが、このような感じでどうでしょうか? (ROUGE) '---- Sub test() Dim tbl1, tbl2, dic1 As Object, dic2 As Object Dim wb As Workbook, x, i As Long Dim flg1 As Boolean, flg2 As Boolean, flg3 As Boolean, flg4 As Boolean flg1 = True: flg2 = True: flg3 = True: flg4 = True Set dic1 = CreateObject("Scripting.Dictionary") Set dic2 = CreateObject("Scripting.Dictionary") For Each wb In Workbooks If wb.Name = "Book1.xls" Then flg1 = False If wb.Name = "Book2.xls" Then flg2 = False If wb.Name = "Book3.xls" Then flg3 = False If wb.Name = "Book4.xls" Then flg4 = False Next If flg1 Then Workbooks.Open ThisWorkbook.Path & "¥Book1.xls" If flg2 Then Workbooks.Open ThisWorkbook.Path & "¥Book2.xls" If flg3 Then Workbooks.Open ThisWorkbook.Path & "¥Book3.xls" If flg4 Then Workbooks.Open ThisWorkbook.Path & "¥Book4.xls" For Each x In Array("Book1.xls", "Book2.xls", "Book3.xls", "Book4.xls") With Workbooks(x) With .Sheets("完了調書") ' tbl1 = .Range("O1:O" & .Range("O" & Rows.Count).End(xlUp).Row) tbl1 = .Range("O:O") End With With .Sheets("不能調書") ' tbl2 = .Range("O1:O" & .Range("O" & Rows.Count).End(xlUp).Row) tbl2 = .Range("O:O") End With End With For i = 1 To UBound(tbl1, 1) If Not IsEmpty(tbl1(i, 1)) Then If Not dic1.Exists(tbl1(i, 1)) Then dic1(tbl1(i, 1)) = False Else dic1(tbl1(i, 1)) = True End If End If Next For i = 1 To UBound(tbl2, 1) If Not IsEmpty(tbl2(i, 1)) Then If Not dic2.Exists(tbl2(i, 1)) Then dic2(tbl2(i, 1)) = False Else dic2(tbl2(i, 1)) = True End If End If Next Next If flg1 Then Workbooks("Book1.xls").Close If flg2 Then Workbooks("Book2.xls").Close If flg3 Then Workbooks("Book3.xls").Close If flg4 Then Workbooks("Book4.xls").Close i = 0 With ThisWorkbook With .Sheets("完了調書").Range("A:B") .ClearContents .Interior.ColorIndex = xlNone End With With .Sheets("不能調書").Range("A:B") .ClearContents .Interior.ColorIndex = xlNone End With For Each x In dic1.Keys i = i + 1 With .Sheets("完了調書").Range("A" & i) .Value = x If dic1(x) Then .Interior.ColorIndex = 6 .Offset(, 1).Value = "重複" End If End With Next i = 0 For Each x In dic2.Keys i = i + 1 With .Sheets("不能調書").Range("A" & i) .Value = x If dic2(x) Then .Interior.ColorIndex = 6 .Offset(, 1).Value = "重複" End If End With Next End With Erase tbl1, tbl2 Set dic1 = Nothing Set dic2 = Nothing End Sub ----- ありがとうございました。しかしBooK5にマクロを入れてみましたがA列にBooK1〜BooK4の数字がでません??エラー13と出てしまいます?BooK1〜BooK4にもマクロをいれるのでしょうか? ---- Book5に入れたのであればOKだと思いますが・・・ A列ではなくO列に書き出ししています。 エラーはコードのどの部分で出たのでしょうか? (ROUGE) #A列って書いてありましたね・・・orz 修正済み ---- ありがとうございました。しかしエラーが?? Microsoft Visuai Basic 実行時エラー13 型が一致しません 上記のメッセージが出てしまいます。。。デバッグをクリックするとマクロ式の中の For i = 1 To UBound(tbl1, 1)の部分が黄色くなります?? （SL567） ---- Book1〜5のいずれかのシートで、O列に何も記入されていない場合があるものと思われます。 コード修正しておりますので、お試し下さい。 (ROUGE) ----- 何度もすみません。入れ直しましたが今度は実行時エラー9インデックスが有効範囲にありません!表示が出てしまいます?? With Sheets("完了調書").Range("A:B")が黄色く??（SL567） ---- Book5のSheet名は完了調書と不能調書ではないのでしょうか? (ROUGE) ---- Book5のSheet名は完了調書と不能調書ですが??（SL567） ---- ピリオドふたつつけわすれてました^^;(ROUGE) ---- ありがとうございました。感激です!!出来ました。。 今後も、上記のマクロを利用させて頂きます。。質問です。 BooK1:BooK2:BooK3:BooK4:BooK5の名前が違う場合はマクロの中のBooK1〜BooK4で記入されている部分を変更すれば可能でしょうか?同様にシート名も? ---- こちらであれば、名前の変更は不要になります。 ちなみに、Book5のあるフォルダにあるファイルはすべて対象となってしまいますので、 対象となるファイルだけを入れるようにしてください。 Sheet名は一箇所だけ変更すれば良いようにしています。 (ROUGE) '---- Sub Sample() Dim fso As Object, dic1 As Object, dic2 As Object, wb As Workbook Dim myFile, tbl1, tbl2, x, flg As Boolean, i As Long Const sh1 As String = "完了調書" Const sh2 As String = "不能調書" Application.ScreenUpdating = False Set fso = CreateObject("Scripting.FileSystemObject") Set dic1 = CreateObject("Scripting.Dictionary") Set dic2 = CreateObject("Scripting.Dictionary") For Each myFile In fso.GetFolder(ThisWorkbook.Path).Files If Right(myFile.Name, 4) <> ".xls" Then GoTo AAA If myFile.Name = ThisWorkbook.Name Then GoTo AAA flg = True For Each wb In Workbooks If myFile.Name = wb.Name Then flg = False Exit For End If Next If flg Then Set wb = Workbooks.Open(ThisWorkbook.Path & "¥" & myFile.Name) tbl1 = wb.Sheets(sh1).Range("O:O") tbl2 = wb.Sheets(sh2).Range("O:O") For i = 1 To UBound(tbl1, 1) If Not IsEmpty(tbl1(i, 1)) Then If Not dic1.Exists(tbl1(i, 1)) Then dic1(tbl1(i, 1)) = False Else dic1(tbl1(i, 1)) = True End If End If Next For i = 1 To UBound(tbl2, 1) If Not IsEmpty(tbl2(i, 1)) Then If Not dic2.Exists(tbl2(i, 1)) Then dic2(tbl2(i, 1)) = False Else dic2(tbl2(i, 1)) = True End If End If Next Erase tbl1, tbl2 If flg Then wb.Close AAA: Next With ThisWorkbook With .Sheets(sh1).Range("A:B") .ClearContents .Interior.ColorIndex = xlNone End With With .Sheets(sh2).Range("A:B") .ClearContents .Interior.ColorIndex = xlNone End With i = 0 For Each x In dic1.Keys i = i + 1 With .Sheets(sh1).Range("A" & i) .Value = x If dic1(x) Then .Interior.ColorIndex = 6 .Offset(, 1).Value = "重複" End If End With Next i = 0 For Each x In dic2.Keys i = i + 1 With .Sheets(sh2).Range("A" & i) .Value = x If dic2(x) Then .Interior.ColorIndex = 6 .Offset(, 1).Value = "重複" End If End With Next End With Set dic1 = Nothing Set dic2 = Nothing Set fso = Nothing Application.ScreenUpdating = True End Sub... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200610/20061024211146.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97062 documents and 608326 words.
訪問者：