Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

189 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【78675】処理速度を上げたい

北風 - 16/12/15(木) 12:04 -


	引用なし

	パスワード

下記マクロで処理していますがプレヴュー画面へ移行する時時間がかかるような気がします。処理速度を上げる方法はありますか。

Sub セルの値をファイル名にする()
Dim fm As String
Dim fs As Variant
ChDrive "S"
ChDir "S:\1ABT\1612\決定"
Columns("A:B").Select
With ActiveSheet.PageSetup
　　　　.PrintTitleRows = ""
　　　　.PrintTitleColumns = ""
　　End With
　　ActiveSheet.PageSetup.PrintArea = ""
　　With ActiveSheet.PageSetup
　　　　.LeftHeader = ""
　　　　.CenterHeader = ""
　　　　.RightHeader = ""
　　　　.LeftFooter = ""
　　　　.CenterFooter = ""
　　　　.RightFooter = ""
　　　　.LeftMargin = Application.InchesToPoints(0)
　　　　.RightMargin = Application.InchesToPoints(0)
　　　　.TopMargin = Application.InchesToPoints(0.984251968503937)
　　　　.BottomMargin = Application.InchesToPoints(0.984251968503937)
　　　　.HeaderMargin = Application.InchesToPoints(0.511811023622047)
　　　　.FooterMargin = Application.InchesToPoints(0.511811023622047)
　　　　.PrintHeadings = False
　　　　.PrintGridlines = False
　　　　.PrintComments = xlPrintNoComments
　　　　.PrintQuality = 600
　　　　.CenterHorizontally = False
　　　　.CenterVertically = False
　　　　.Orientation = xlPortrait
　　　　.Draft = False
　　　　.PaperSize = xlPaperA4
　　　　.FirstPageNumber = xlAutomatic
　　　　.Order = xlDownThenOver
　　　　.BlackAndWhite = False
　　　　.Zoom = 100
　　　　.PrintErrors = xlPrintErrorsDisplayed
　　End With

　　Columns("A:B").EntireColumn.AutoFit
　　Columns("C:E").Select
　　Selection.ColumnWidth = 5.5
　　Columns("F:F").ColumnWidth = 9.5
　　Columns("G:G").ColumnWidth = 8.25
　　Columns("G:G").EntireColumn.AutoFit
　　ActiveWindow.SelectedSheets.PrintPreview
　　ActiveWindow.SelectedSheets.PrintOut Copies:=1
With ThisWorkbook.ActiveSheet
　fm = .Range("A2").Text & "(" & .Range("F2").Text & ")"
End With
fs = Application.GetSaveAsFilename(fm, "MicrosoftExcelブック(*.xls),*.xls", , "ファイルを保存する", "保存")
If fs = False Then End
ThisWorkbook.SaveAs fs

End Sub

・ツリー全体表示


	【78674】Re:コードが黄色くなる

トキノハジメ - 16/12/14(水) 17:09 -


	引用なし

	パスワード

▼独覚さん：マナさん:rさん:βさん色々有難うございました。
これからよく見て記入いたします。

・ツリー全体表示


	【78673】Re:コードが黄色くなる

独覚 - 16/12/14(水) 16:46 -


	引用なし

	パスワード

▼トキノハジメさん：
マナさんの回答の式と自分の式をよく見比べてください。

マナさん
"=If(E25=0,"""",Round((E25-7.4)/7.4*100 ,1))"

トキノハジメさん
"=If(E25=0,"""",Round((E25-7.4)/7.4*100 .1))"

最後の「1」の前がマナさんが「,」（カンマ）なのに対して「.」（ピリオド）になっています。

・ツリー全体表示


	【78672】Re:コードが黄色くなる

トキノハジメ - 16/12/14(水) 16:34 -


	引用なし

	パスワード

▼独覚さん：
>▼トキノハジメさん：
>現在のコードをそのままコピーしてこちらに張り付けてくれませんか？
>
>あと、エラー時のエラーメッセージはなんですか？

Range("D42").Formula = "=If(E25=0,"""",Round((E25-7.4)/7.4*100 .1))"

実行時エラー　'1004':

アプリケーション定義またはオブジェクト定義のエラーです。

独覚さん上記のとおりです。
宜しくお願い致します。

・ツリー全体表示


	【78671】Re:コードが黄色くなる

独覚 - 16/12/14(水) 15:11 -


	引用なし

	パスワード

▼トキノハジメさん：
現在のコードをそのままコピーしてこちらに張り付けてくれませんか？

あと、エラー時のエラーメッセージはなんですか？

・ツリー全体表示


	【78670】Re:コードが黄色くなる

トキノハジメ - 16/12/14(水) 14:22 -


	引用なし

	パスワード

▼β さん：
>
>シート上のどこかのセルに
>
>=If(E25=0,"",Round((E25-7.4)/7.4*100 ,1))
>
お返事有難うございます。

最初の質問に書きましたように

range("D42"),Formura = とD42に結果を出したいのですが実行しても黄色く成ってエラー表示がでます。ので、なおE25 には数字２５がはいっています。よろしくお願いいたします。

・ツリー全体表示


	【78669】Re:コードが黄色くなる

β - 16/12/14(水) 12:26 -


	引用なし

	パスワード

▼トキノハジメさん：

横から失礼します。

>頂いたコード使ってみましたが、結果が表示されません。

マナさんの回答は、あくまで

>コードが黄色くなる

この質問に対する回答です。
黄色くならなかったんでしょ？
であれば、質問自体は、解決ということでしょ？

で、その実行結果が思ったようにならない、これは、我々から見れば
なぜか、それはわかりません。トキノハジメさんしかわかりません。

シート上のどこかのセルに

=If(E25=0,"",Round((E25-7.4)/7.4*100 ,1))

こう入力すると、結果はどうなりますか？
これでも、思ったようにならないということでしょ？
なぜか。それはわからないですね。

これは、この式が正しいか正しくないかということですから。

・ツリー全体表示


	【78668】Re:コードが黄色くなる

γ - 16/12/14(水) 12:26 -


	引用なし

	パスワード

>頂いたコード使ってみましたが、結果が表示されません。
>再度お願いいたします。
E25には何が入っていて、どんな結果を想定して
いますか？
再度って言われるが、
他人に尋ねるようなことなんですか？

・ツリー全体表示


	【78667】Re:コードが黄色くなる

トキノハジメ - 16/12/14(水) 9:36 -


	引用なし

	パスワード

▼マナさん：

>= "=If(E25=0,"""",Round((E25-7.4)/7.4*100 ,1))"

お返事有難う御座います。
頂いたコード使ってみましたが、結果が表示されません。
再度お願いいたします。

・ツリー全体表示


	【78666】Re:コードが黄色くなる

マナ - 16/12/13(火) 22:28 -


	引用なし

	パスワード

▼トキノハジメさん：

こうでしょうか？

= "=If(E25=0,"""",Round((E25-7.4)/7.4*100 ,1))"

・ツリー全体表示


	【78665】コードが黄色くなる

トキノハジメ - 16/12/13(火) 20:12 -


	引用なし

	パスワード

いつもお世話になります。
何処を直せ刷毛良いのか教えて下さい。

Range("D42").Formula = "If(E25=0,"""",Round((E25-7.4)/7.4*100) ,1)"

上記のコードです。宜しくお願い致します。

・ツリー全体表示


	【78664】Re:SetCurrentDirectoryでネットワーク上...

亀マスター - 16/12/12(月) 19:48 -


	引用なし

	パスワード

カレントディレクトリを移動させたいというのは、ファイル選択のダイアログで最初に表示されるディレクトリを指定したいということですよね。
これまでの経過からして、アクセス権自体が怪しいので上手くいかない可能性が高い気がしますが、FileDialogオブジェクトも試してみてはどうでしょうか。

'Microsoft Office ○○ Object Libraryの参照設定があるなら不要
'○○はOfficeのバージョンによる数字
Const msoFileDialogOpen As Long = 1

With Application.FileDialog(msoFileDialogOpen)
　　With .Filters
　　　　.Clear
　　　　.Add "Excel ファイル", "*.xls; *.xlsx", 1 '拡張子は必要に応じて変えてください
　　End With
　　.InitialFileName = "任意のディレクトリパス" '（例　\\ServerName\Sample\"）
　　If .Show Then
　　　　.Execute
　　End If
End With

・ツリー全体表示


	【78663】Re:SetCurrentDirectoryでネットワーク上...

アソビン - 16/12/12(月) 9:17 -


	引用なし

	パスワード

▼亀マスターさん：
お返事ありがとうございます。こちらからのお返事が遅くなりまして申し訳ありません。

>本来設定したいディレクトリでSetCurrentDirectoryした後、指定したところと違うパスがカレントディレクトリになっているということでしょうか、それとも、SetCurrentDirectory自体がエラーになるということでしょうか。

説明が足りず申し訳ありません。
私のソースで言うと、
「Fpath = "\\xx.○○○.co.jp\fss2-g$\"　 '←ここまでなら開ける」
このパスを設定している時は確かにこのディレクトリがカレントになります。
しかし、ソース上でコメントアウトしている、
「'Fpath = "\\xx.○○○.co.jp\fss2-g$\01037\vlyk\Process\" '←本当はここをカレントにしたい」
を設定すると、その前にカレントになっているディレクトリが表示されます。
例えばうまく動いてくれないので色々と試していたとして、一つ前に試しにデスクトップをカレントに設定してみた場合等は、上記の設定をしても前回同様にデスクトップがカレントとして開いてしまいます。

>指定したディレクトリにアクセス権限がないとか…いうことはなさそうですね、手動でそこまで辿れるようですし。

はい。手動では辿り着きますのでアクセス権限の問題はありません。

>SetCurrentDirectoryが機能しない理由はよくわかりませんが、代替手段としてWindows Scripting HostのCurrentDirectoryプロパティを試してみてはどうでしょうか。
>
>CreateObject("WScript.Shell").CurrentDirectory = "ディレクトリパス"
>
>で同じことができるはずです。

試してみました。すると「実行時エラー'70': 書き込みできません。」のエラーが出ます。
ソース上で「ここまでなら開ける」となっているパスを設定するとこちらは正しくカレントに設定されますのでやはりクラスタリングされているサーバには辿り着けないということでしょうか。
ちなみに、書き込みできませんのエラーが出たウィンドウでヘルプを見ると「アクセスが拒否されました（エラー70）」という項目が開くので、これは明らかにアクセス拒否されているということですよね…

何か方法はないのでしょうか…うーん…

・ツリー全体表示


	【78662】Re:SetCurrentDirectoryでネットワーク上...

亀マスター - 16/12/9(金) 21:28 -


	引用なし

	パスワード

本来設定したいディレクトリでSetCurrentDirectoryした後、指定したところと違うパスがカレントディレクトリになっているということでしょうか、それとも、SetCurrentDirectory自体がエラーになるということでしょうか。

指定したディレクトリにアクセス権限がないとか…いうことはなさそうですね、手動でそこまで辿れるようですし。

SetCurrentDirectoryが機能しない理由はよくわかりませんが、代替手段としてWindows Scripting HostのCurrentDirectoryプロパティを試してみてはどうでしょうか。

CreateObject("WScript.Shell").CurrentDirectory = "ディレクトリパス"

で同じことができるはずです。

ネットワーク関連の知識が乏しいので、サーバーの設定の問題が原因でしたらトンチンカンなことを言ってるかもしれませんが…。

・ツリー全体表示


	【78661】SetCurrentDirectoryでネットワーク上の...

アソビン - 16/12/9(金) 14:24 -


	引用なし

	パスワード

初めてお世話になります。
タイトルの通り、SetCurrentDirectoryでネットワーク上のディレクトリをカレントリにしたいと思っています。
APIを使用しているのですが、ネットワークの"ある階層"にまでしか辿り着けません。

パケットキャプチャしてみた所、IPアドレスが、"ある階層"から先で変わってしまっています。
調べてみたところではサーバのクラスタリングというものが行われているようなのですが、こういったサーバ構成の場合
SetCurrentDirectoryではカレントの変更はできないのでしょうか。
変更出来るギリギリの所をカレントにしておいてGetOpenfilenameのダイアログで自分で階層を進んでいけばファイル
を選択することは出来るのですが、階層が深かったりディレクトリが沢山あったりして誰にでも目的のファイルがすぐに
開けるとは言い難いので、出来るだけ目的のファイルがあるディレクトリをカレントにしておきたいのです。
解決方法がありましたらご教示下さい。よろしくお願い致します。
ソースを書いておきます。

Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
Option Explicit

Sub LifeTime_FilePath()
　　Dim Fpath As String
　　Dim myFile As Variant
　　
　　'Fpath = "\\xx.○○○.co.jp\fss2-g$\01037\vlyk\Process\" '←本当はここをカレントにしたい
　　Fpath = "\\xx.○○○.co.jp\fss2-g$\"　　　　　　　　　　 '←ここまでなら開ける

　　'ファイル選択ダイアログ
　　SetCurrentDirectory (Fpath)
　　myFile = Application.GetOpenFilename(FileFilter:="エクセルファイル, *.xls", MultiSelect:=True)

End Sub

・ツリー全体表示


	【78660】Re:プレヴュー画面の左右余白

北風 - 16/12/9(金) 12:54 -


	引用なし

	パスワード

▼β さん：
解決しました有難うございます

>▼北風さん：
>
>勘違いしているかもしれませんが、プレビュー画面の余白ではなく
>印刷対象シートのページ設定としての左右余白のことではないですか？
>
>であれば、
>そのシートを表示した状態で、
>
>ページレイアウトタブ-->ページ設定グループの余白
>ユーザー設定の余白(A) を選んで、左右の余白を 0 に指定。
>
>これをマクロ記録してみてください。

・ツリー全体表示


	【78659】Re:プレヴュー画面の左右余白

β - 16/12/8(木) 12:04 -


	引用なし

	パスワード

▼北風さん：

勘違いしているかもしれませんが、プレビュー画面の余白ではなく
印刷対象シートのページ設定としての左右余白のことではないですか？

であれば、
そのシートを表示した状態で、

ページレイアウトタブ-->ページ設定グループの余白
ユーザー設定の余白(A) を選んで、左右の余白を 0 に指定。

これをマクロ記録してみてください。

・ツリー全体表示


	【78658】プレヴュー画面の左右余白

北風 - 16/12/8(木) 11:46 -


	引用なし

	パスワード

下記マクロでプレヴュー画面の立ち上げから印刷までを利用しておりますが
プレヴュー画面で左右の余白を0設定したいのですが宜しくお願いいたします。

Sub セルの値をファイル名にする()
Dim fm As String
Dim fs As Variant
ChDrive "S"
ChDir "S:\1ABT\1612\決定"
Columns("A:B").Select
　　Columns("A:B").EntireColumn.AutoFit
　　Columns("C:E").Select
　　Selection.ColumnWidth = 5.5
　　Columns("F:F").ColumnWidth = 9.5
　　Columns("G:G").ColumnWidth = 8.25
　　Columns("G:G").EntireColumn.AutoFit
　　ActiveWindow.SelectedSheets.PrintPreview
　　ActiveWindow.SelectedSheets.PrintOut Copies:=1
With ThisWorkbook.ActiveSheet
　fm = .Range("A2").Text & "(" & .Range("F2").Text & ")"
End With
fs = Application.GetSaveAsFilename(fm, "MicrosoftExcelブック(*.xls),*.xls", , "ファイルを保存する", "保存")
If fs = False Then End
ThisWorkbook.SaveAs fs

End Sub

・ツリー全体表示


	【78657】Re:特定の文字列の入っている行を削除し...

piropiro - 16/12/5(月) 19:01 -


	引用なし

	パスワード

▼β さん：

>ごめんなさい。ある行に複数NAがあって、その中のどれかの上下にも連続したNAがあるんですね。
>コードを少し変更しました。

すみません。その通りです。説明不足で2度手間になってしまって
こちらこそ申し訳ありません＞＜

そして！すごい！！！
手動の結果と全く同じです！
こんなに丁寧に教えてくださって本当に感謝してます。
ありがとうございます。

でも実はこのコードを実行する前に
任意のフォルダを選択→そのフォルダ内のファイルをすべて結合
→重複削除
を実行してからβさんのコードを実行するのですが
すべて通してやると、また49行が削除されてしまうのです。

でも、今回の質問に関しては解決していただいたので
ここでCLOSEさせて頂きます。

どうしてもまたわからなかったら再度質問させて頂きます。
本当にお世話になりました。ありがとうございます！

・ツリー全体表示


	【78656】Re:特定の文字列の入っている行を削除し...

β - 16/12/5(月) 17:45 -


	引用なし

	パスワード

▼piropiro さん：

ごめんなさい。ある行に複数NAがあって、その中のどれかの上下にも連続したNAがあるんですね。
コードを少し変更しました。

Sub Test()
　　Dim a As Range
　　Dim r As Range
　　Dim c As Range
　　Dim f As Range
　　Dim x As Long

　　 '使用領域の K列から最終列までの列数
　　 x = Range("A1", ActiveSheet.UsedRange).Columns.Count - 10
　　'判定対象領域
　　 Set a = Range("I4", Range("I" & Rows.Count).End(xlUp)).Offset(, 2).Resize(, x)

　　 Set c = a.Find(What:="NA", LookAt:=xlWhole, LookIn:=xlFormulas)
　　If c Is Nothing Then
　　　　MsgBox "領域に NA はありません"
　　　　Exit Sub
　　End If

　　 Set f = c

　　 Do
　　　　If r Is Nothing Then
　　　　　　Set r = c.EntireRow
　　　　Else
　　　　　　Set r = Union(r, c.EntireRow)
　　　　End If
　　　　Set c = a.FindNext(c)
　　Loop While c.Address <> f.Address
　　
　　r.Delete

End Sub

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

189 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free