エクセル2013です。
以下のようなマクロを作成しました。
For Each が2回、回る為、処理時間が長いです。
For Each を1かいで済ませたくif文をandでつなげば
といろいろ試しましたが、うまくできません。
For Each を1回で済ませるにはどうすればいいでしょうか?
よろしくお願いします。
Sub 出荷済削除()
Dim 対象セル As Range
Dim 対象色 As Long
Dim 対象色2 As Long
Dim 最終行
Dim 最終列
最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得
最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得
Application.ScreenUpdating = False '画面切替停止
対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする
For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列))
If 対象セル.Interior.Color = 対象色 Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする
Next 対象セル
対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする
For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列))
If 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする
Next 対象セル
Application.ScreenUpdating = True '画面切替停止解除
End Sub
ExcelのVBA初心者です。
ファイルを新しい日付のものから順番に検索したいのですが、幾ら探しても分かりませんでした。どなたか教えていただけないでしょうか?
やりたいことは、あるフォルダ内に毎日5~6個のファイルが保存されていくのですが、その中の決められたセルに指定した文字列が含まれているもの3つ場合分けしてファイルを出力したいのです。
例えば、
ファイル名 セルE1の内容 日付
123.xls ”111111A” 6/29 15:39:40
456.xls ”111111N” 6/29 15:35:10
789.xls ”222222V” 6/29 15:20:43
654.xls ”222222A” 6/29 14:30:21
321.xls ”111111V” 6/29 14:10:33
951.xls ”222222N” 6/28 17:52:15
753.xls ”333333A” 6/28 17:30:50
とファイルがあり、セルE1に”111111”の文字列を含むファイルを検索し、
末尾に”V”があるもの → f(1)=321.xls
末尾に”N”があるもの → f(2)=456.xls
末尾に”A”があるもの → f(3)=123.xls
と出力したいのです。
分からないなりに、いろいろ調べて切り貼りしながら作ってみました。
これで一応うまくいったのですが、検索する文字列は、必ず上記例のように新しい日付の5~6ファイルの中にあり、検索対象のフォルダ内には1000個以上ファイルがあります。
上記プログラムだと読み込む順番が最後になってしまいますので、恐ろしく処理時間が掛かってしまいます。
Sub ファイル検索()
Dim buf As String, cnt As Long
Dim i As Integer
Dim wb(3)
Dim bk As String, lot As String, lt As String
Dim Path As String
Application.ScreenUpdating = False
lt = Cells(1, 5)
bk = ActiveWorkbook.Name
Path = Cells(1, 5)
buf = Dir(Path & "*.xls")
i = 1
Do While wb(1) = "" Or wb(2) = "" Or wb(3) = ""
cnt = cnt + 1
Workbooks.Open Path & buf
Select Case Cells(2, 5)
Case Is = lt & "V"
wb(1) = buf
Case Is = lt & "N"
wb(2) = buf
Case Is = lt & "A"
wb(3) = buf
End Select
Application.DisplayAlerts = False
Workbooks(buf).Close
Application.DisplayAlerts = True
buf = Dir()
Loop
For i = 1 To 3
Workbooks(bk).Sheets(1).Cells(i, 1) = "wb(" & i & ")" & "=" & wb(i)
Next i
Application.ScreenUpdating = True
End Sub
日付の新しいファイルから読み込む良い方法はないでしょうか?
Excelのバージョンは、2003です。
出来れば、2003~2010で対応できる方法があれば、ベストです。
よろしくお願い致します。
表を管理していて、前月のある日に保存した内容と
翌月のある日に保存した内容を比較して
差分を取りたいのです。
例えば、表を更新した時に行が追加されたりして
レコードはひとつ追加になっているけれど
他の内容は変わってないとします。
しかし、同じ位置の同じセルの値を比較だと
追加した行以降全てのセルに色が付いてしまいます。
これを、追加された行(レコード)だけを
色付けるようにしたいのです。
>If s1.Cells(gyou, retsu).Value <> s2.Cells(gyou, retsu).Value Then
>
> '同じ位置のセルの値が等しくなければ、そのセルを赤で塗りつぶす。
この部分に手を加えればいいのかと思うのですが、解りません。
どのようにすればいいのか教えていただけないでしょうか?
お願いいたします。
Sub シート比較()
Dim RETSU_S, RETSU_E, GYOU_S, GYOU_E As Long
RETSU_S = 1
RETSU_E = 10
GYOU_S = 2
GYOU_E = 101
Dim s1, s2 As Worksheet
Set s1 = Worksheets("Sheet1")
Set s2 = Worksheets("Sheet2")
Dim retsu, gyou As Long 'この変数で列と行を指定する
For gyou = GYOU_S To GYOU_E
For retsu = RETSU_S To RETSU_E
If s1.Cells(gyou, retsu).Value <> s2.Cells(gyou, retsu).Value Then
'同じ位置のセルの値が等しくなければ、そのセルを赤で塗りつぶす。
s1.Cells(gyou, retsu).Interior.ColorIndex = 3
s2.Cells(gyou, retsu).Interior.ColorIndex = 3
End If
Next
Next
End Sub
VBAのコピーペーストの下記プログラムで、
Sub コピー()
Dim rng As Range
Set rng = Worksheets("2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
With Range("b2:J10")
rng.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End Sub
コピー範囲 のJ10の部分(データ入力行)が、その都度変わるため、J10の部分を、
J列のデータが入力されている最終行としたいのですが、どのようなプログラムに
すればよいのでしょうか。
どなたかよろしくお願いいたします。
1つのフォルダの中に
4つのエクセルファイルがあります。
そのエクセルファイルの中に12というファイル名がある場合は
メッセージを出したいと考えて以下のコードを書きました。
この4つのファイルのうち1つのファイルに12のシートを
存在させてみて、以下のコードで実行しました。
Sub シートの確認2()
Const MyPath As String = "C:\test\"
Dim MyBook As Workbook
Dim MyFileName As String
Dim MyRng As Range
Dim i As Long
Dim ws As Worksheet, flag As Boolean
MyFileName = Dir(MyPath & "*.xlsx")
Do While MyFileName <> ""
If ThisWorkbook.Name <> MyFileName Then
Set MyBook = Workbooks.Open(MyPath & MyFileName)
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "12" Then
MsgBox "[12]シートが存在しません。"
Else
MsgBox "[12]シートが存在します。"
End If
Next i
MyBook.Close
End If
MyFileName = Dir()
Loop
End Sub
すると、
12という名前のあるシートを持つブックの場合、
"[12]シートが存在しません。"
"[12]シートが存在します。"
の両方のメッセージが出てきます。
おそらく考えるに
そのブックにはシートが2枚あり、
そのうち1つが12という名前のシートであり
もう一つは違う名前なので
このような現象が出てくるのではないかと。
ただ単純に、その同一フォルダ内のブックに12というがあるかないかを
取得するにはどうしたらよいでしょうか?