いつもお世話になります。
WIN7 EXCELL2010です。
一つのシートに４ヶ月分があって合計３つのシートがあります。
１月のみの記入するところのマクロは下記のマクロのように何とか作成しました。
一つのシートでRangeが４ヶ所に分かれている場合で
B6:B8(下記のマクロ) B18:AF20 B30:AF32 B B42:AF44
ですが下記のマクロをどう変えればベストかを誠に申し訳ありませんがご指導いただけないでしょうか。
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Intersect(Target, Range("B6:AF8")) Is Nothing Then Exit Sub
.Font.ColorIndex = 0
Application.EnableEvents = False
Select Case .Value
Case 0: .Value = Empty
Case 1 To 3
.Value = Choose(.Value, "営業", "休日", "特休")
Case 4 To 9
.Value = Choose(.Value - 3 , "出勤",”代休”,”有給”,”休出”,”遅刻”,”早退”)
End Select
Application.EnableEvents = True
End With
End Sub
【再掲載＆追加情報です】
ずっとwindowsXP SP3を使用していたのですが（Excel2002 SP3もそのまま）
今回急遽社内のパソコンが2台（1台は自分のです）だけWindows7に変わりました。
その2台だけExcelも2002から2010に変わったのですが、使用しているファイルで記述してる
FileSearchが使えないとあとから知りました。（泣）
ネットで検索してFileSystemObjectを代わりに使用するというのを知りましたが
初心者の為理解が難しく・・・。
申し訳ありませんが記述の変更方法を教えていただけないでしょうか？
（１）フォルダーは ”C:\指示\記入済” に出来たExcelファイルを保存してます
（２）番号は指定フォルダ内のエクセルファイルをカウントしてその数＋1を
U1のセルに表示させています。
（３）作成した保存ボタンで新見積書を保存する
但し、マクロコードとボタンを削除したものを保存する
（４）新見積書の保存後はブック、エクセルともに終了する
**************現在使用中データ**************
--- Module1 ----
Public Const FPath = "C:\指示\記入済"
'xlsファイル検索
Sub Auto_Open()
With Application.FileSearch
.NewSearch
.Filename = "*.xls"
.FileType = msoFileTypeAllFiles
.LookIn = FPath
.SearchSubFolders = False
.Execute
Cells(1, 21).Value = .FoundFiles.Count + 1
Cells(1, 21).NumberFormat = "0000"
End With
End Sub
--- Module2 ----
Sub ファイルに名前を付けて保存()
Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = FPath & "\" & Range("T1") & Format(Range("U1"), "0000") & Range("B1") & ".xls"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)
If 保存ファイル名 = False Then
MsgBox "保存は中止されました"
Exit Sub
End If
ActiveWorkbook.SaveCopyAs 保存ファイル名
Dim NewBook As Workbook
Set NewBook = Workbooks.Open(保存ファイル名)
Dim myVBA As Object
For Each myVBA In NewBook.VBProject.VBComponents
With myVBA
If .Type = 100 Then
.CodeModule.DeleteLines 1, .CodeModule.CountOfLines
Else
Application.VBE.activeVBProject.VBComponents.Remove myVBA
End If
End With
Next myVBA
NewBook.ActiveSheet.Shapes(1).Delete
NewBook.Close True
'●●●
Set NewBook = Workbooks.Open(保存ファイル名)
NewBook.Close True
'●●●
'ブックとエクセル終了
Application.Quit
ThisWorkbook.Close False
End Sub
********************************************
上記がExcel2002で問題なく動いている記述です。
最初Excel2010で起動してエラーが出たので検索したとき、てっきりFileSearchだけが問題
だと思っていたのですがもしかして他にもあったのでしょうか？
--- Module1 ----は、先ほど質問したときに
Public Const FPath = "C:\指示\記入済"
'xlsファイル検索
Sub Auto_Open()
Dim tmp as String
Dim i as Long
tmp = Dir(FPath & "¥*.xls")
Do While tmp <> ""
i = i + 1
tmp = Dir()
Loop
Cells(1, 21).Value = i+1
Cells(1, 21).NumberFormat = "0000"
End Sub
に変更したら動くようになりました。
ただ、作成した保存ボタンを押すと指定した場所に指定したセルの文字を拾って
ファイル名を表示させるまでマクロに登録（Module2）したのですが、
指定したフォルダは開いてるのですがファイル名が空欄のままです。
更にそれに手打ちでファイル名を打ち、保存すると
実行時エラー1004
プログラミングによるVisualBasicプロジェクトへのアクセスは信頼性に欠けます
と表示されます・・・。
デバックを押すと
For Each myVBA In NewBook.VBProject.VBComponents
の部分が黄色くなってました＞＜
他に情報としては
このファイルはxlt（テンプレート）にしています。
使用者たちにはファイル名を打たせないように上記のようにしました。
再度宜しくお願いします・・・。
何度もお手数をおかけしまして申し訳ありません。。。
ExcelのSlope関数をVBAで繰返し処理させたいのですが、自分が作製したプログラムですと、処理に時間がかかってしまう事がわかりました（正常動作はするのですが、Excelの動きが鈍い）。
動きが遅くなってしまう部分はおそらくここだろうと部分をピックアップしたので、処理が軽くなる方法がわかる方いらっしゃいましたら、教えて下さい。宜しくお願い致します。
i = 1
n = 55
Do While i < 3
i = Sheets("Sheet2").Cells(n, 2)
n = n + 1
Loop
n = n - 2
Worksheets("Sheet3").Range("Q16").Formula = "=Slope(Sheet2! C55:C" & n & ",Sheet2!B55:B" & n & "）"
Worksheets("Sheet3").Range("Q17").Formula = "=Slope(Sheet2! E55:E" & n & ",Sheet2!D55:D" & n & "）"
Worksheets("Sheet3").Range("Q18").Formula = "=Slope(Sheet2! G55:G" & n & ",Sheet2!F55:F" & n & "）"
・
・
・
・
・
Worksheets("Sheet3").Range("Q28").Formula = "=Slope(Sheet2! AA55:AA" & n & ",Sheet2!Z55:Z" & n & "）"
お世話になります。
下記のVBAソースで、特定のフォルダにあるエクセルを全て
開く処理をしているのですが、スマートに行えているか
疑問に思いました。
具体的には、「'''''''''時間がかかっている？？」箇所で
無駄なこと・時間がかかっていないか疑問です。
目的としては、「vba で全てのエクセルファイルを開く処理」ですので、
(1)皆さんがされている「vba で全てのエクセルファイルを開く処理」
(2)下記ソースの「'''''''''時間がかかっている？？」は時間がかかっていないか
の、どちらかで、結構ですのでご返事頂ければ有り難いです。
宜しくお願いします。
------------ソース-----------------
ChDir (ThisWorkbook.Path & "\" & フォルダ)
fileName = Dir("*.xls")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
IsBookOpen = False
'''''''''時間がかかっている？？
For Each OpenedBook In Workbooks
If OpenedBook.Name = fileName Then
IsBookOpen = True
Exit For
End If
Next
'''''''''時間がかかっている？？
If IsBookOpen = False Then
Workbooks.Open (fileName)
End If
End If
fileName = Dir()
Loop
お世話になります。
下記のVBAソースで、特定のフォルダにあるエクセルを全て
開く処理をしているのですが、スマートに行えているか
疑問に思いました。
具体的には、「'''''''''時間がかかっている？？」箇所で
無駄なこと・時間がかかっていないか疑問です。
目的としては、「vba で全てのエクセルファイルを開く処理」ですので、
(1)皆さんがされている「vba で全てのエクセルファイルを開く処理」
(2)下記ソースの「'''''''''時間がかかっている？？」は時間がかかっていないか
の、どちらかで、結構ですのでご返事頂ければ有り難いです。
宜しくお願いします。
------------ソース-----------------
ChDir (ThisWorkbook.Path & "\" & フォルダ)
fileName = Dir("*.xls")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
IsBookOpen = False
'''''''''時間がかかっている？？
For Each OpenedBook In Workbooks
If OpenedBook.Name = fileName Then
IsBookOpen = True
Exit For
End If
Next
'''''''''時間がかかっている？？
If IsBookOpen = False Then
Workbooks.Open (fileName)
End If
End If
fileName = Dir()
Loop
お世話になります。
下記のVBAソースで、特定のフォルダにあるエクセルを全て
開く処理をしているのですが、スマートに行えているか
疑問に思いました。
具体的には、「'''''''''時間がかかっている？？」箇所で
無駄なこと・時間がかかっていないか疑問です。
目的としては、「vba で全てのエクセルファイルを開く処理」ですので、
(1)皆さんがされている「vba で全てのエクセルファイルを開く処理」
(2)下記ソースの「'''''''''時間がかかっている？？」は時間がかかっていないか
の、どちらかで、結構ですのでご返事頂ければ有り難いです。
宜しくお願いします。
------------ソース-----------------
ChDir (ThisWorkbook.Path & "\" & フォルダ)
fileName = Dir("*.xls")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
IsBookOpen = False
'''''''''時間がかかっている？？
For Each OpenedBook In Workbooks
If OpenedBook.Name = fileName Then
IsBookOpen = True
Exit For
End If
Next
'''''''''時間がかかっている？？
If IsBookOpen = False Then
Workbooks.Open (fileName)
End If
End If
fileName = Dir()
Loop
お世話になります。
下記のVBAソースで、特定のフォルダにあるエクセルを全て
開く処理をしているのですが、スマートに行えているか
疑問に思いました。
具体的には、「'''''''''時間がかかっている？？」箇所で
無駄なこと・時間がかかっていないか疑問です。
目的としては、「vba で全てのエクセルファイルを開く処理」ですので、
(1)皆さんがされている「vba で全てのエクセルファイルを開く処理」
(2)下記ソースの「'''''''''時間がかかっている？？」は時間がかかっていないか
の、どちらかで、結構ですのでご返事頂ければ有り難いです。
宜しくお願いします。
------------ソース-----------------
ChDir (ThisWorkbook.Path & "\" & フォルダ)
fileName = Dir("*.xls")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
IsBookOpen = False
'''''''''時間がかかっている？？
For Each OpenedBook In Workbooks
If OpenedBook.Name = fileName Then
IsBookOpen = True
Exit For
End If
Next
'''''''''時間がかかっている？？
If IsBookOpen = False Then
Workbooks.Open (fileName)
End If
End If
fileName = Dir()
Loop
ExcelのVBAです。
作っているのですが、
絞り込む物がリストに無くても、
絞込み、空のページが表示されます。
例えば、
A B C
１ あ K A
２ い K A
３ う L A
上記のようなデータがある場合に、
B列のフィルタには
K 、 L の絞込みリストが表示されます。
しかし、VBAの場合は
K、L以外の入力で絞り込むことができます。
例）あいうえおでB列絞り込んでみる
Selection.AutoFilter Field:=Range("B1").Column, _
Criteria1:="あいうえお"
当然のことですが、
あいうえおと表記された所はないため、
何も表示されません。
せめてポップアップを出し、中止を促したいです。
MsgBox "絞り込み条件がありません "
MsgBox "絞り込めないため終了します"
などなど。
できれば、エラーメッセージをだし
再入力を求めるなどあれば良いのですが、
なにか良い方法はありますか？
お世話になります。
vbaで、下記の様なif文があるときに、
iは、1,2,3のどれで合致しているか判別する方法はありますか?
現在は、下記のように処理(1)を繰り返し、書いているのを
一度で済ませたいと思っています。
-------現在----------------
if i=1 then
'処理(1)
'iの値が1の時の処理
elseif i=2 then
'処理(1)
'iの値が2の時の処理
elseif i=3 then
'処理(1)
'iの値が3の時の処理
endif
-----------------------------------
----------------理想---------------------------
if i=1 or i=2 or i=3 then
'処理(1)
★★ここの時点でiの値を取りたい
endif
'処理で、iの値によって分岐
------------------------------------------
今会社でエクセルを作成しています。
使用しているエクセルは2003です。
Ctrl+Fの機能とオートフィルタの機能を足したものを作成しようとしています。
現在 入力している内容は下記になります。
Dim txt As String
Dim target As Range
Dim rng As Range
Dim adr As String
'Set target = Range("A6:L6 & Rows.Count) '
txt = InputBox("検索する内容を記述して下さい。")
If txt = "" Then Exit Sub
Set rng = target.Find(txt, After:=target(target.Count), LookAt:=xlPart)
If rng Is Nothing Then
MsgBox "ありません"
Exit Sub
End If
adr = rng.Address
Do
rng.Activate
Set rng = Range("A6:L" & Rows.Count).FindNext(rng)
If rng.Address = adr Then MsgBox "終わりに達しました"
If MsgBox("続けて調べますか?", vbYesNo) = vbNo Then Exit Do
Loop
End Sub
項目はA6からL6までに記入されていきます。
一部内容は空白の部分もでますが、A6・B6は必須入力です。
下方向に内容が無限に増えて行きます。
現在エラーで
“オブジェクト変数または With ブロック変数が設定されていません”と出てしまっています。
Set rng = target.Find(txt, After:=target(target.Count), LookAt:=xlPart)
ここの部分がおかしいように思われます。
ですが、どう直せばいいのか分からず先に進めません…
皆様の知識をお借りできればと思い投稿致しました。
何卒宜しくお願い致します。
今会社でエクセルを作成しています。
使用しているエクセルは2003です。
Ctrl+Fの機能とオートフィルタの機能を足したものを作成しようとしています。
現在 入力している内容は下記になります。
Dim txt As String
Dim target As Range
Dim rng As Range
Dim adr As String
'Set target = Range("A6:L6 & Rows.Count) '
txt = InputBox("検索する内容を記述して下さい。")
If txt = "" Then Exit Sub
Set rng = target.Find(txt, After:=target(target.Count), LookAt:=xlPart)
If rng Is Nothing Then
MsgBox "ありません"
Exit Sub
End If
adr = rng.Address
Do
rng.Activate
Set rng = Range("A6:L" & Rows.Count).FindNext(rng)
If rng.Address = adr Then MsgBox "終わりに達しました"
If MsgBox("続けて調べますか?", vbYesNo) = vbNo Then Exit Do
Loop
End Sub
項目はA6からL6までに記入されていきます。
一部内容は空白の部分もでますが、A6・B6は必須入力です。
下方向に内容が無限に増えて行きます。
現在エラーで
“オブジェクト変数または With ブロック変数が設定されていません”と出てしまっています。
Set rng = target.Find(txt, After:=target(target.Count), LookAt:=xlPart)
ここの部分がおかしいように思われます。
ですが、どう直せばいいのか分からず先に進めません…
皆様の知識をお借りできればと思い投稿致しました。
何卒宜しくお願い致します。
