Excel VBA質問箱 IV

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

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


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

81 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80854】Re:web クエリの高速化

γ - 19/6/1(土) 9:29 -


	引用なし

	パスワード

提示されたマクロとマクロ１マクロ２の関係がよくわかりませんが、
3000個の繰り返しを2時間と言うことは、一件2.4秒ですか。

ネットの状況、サーバー側のレスポンス等の状況に依存しますが、
その程度はかかるのかもしれませんよ。

Webクエリ自体はパッケージ化されたものなので、
ユーザー側で手を加えて高速化するとか言ったことはできません。

シート間の転記も3項目だけなら、そこが足を引っ張ることも
考えにくいでしょう。

・ツリー全体表示


	【80853】Re:vba初心者

γ - 19/6/1(土) 9:20 -


	引用なし

	パスワード

>デバッグが表示されます。それだけではなく、もっと状況を説明しましょう。どの行でエラーになるのか、エラーメッセージは何か。関係する変数はどうなっているのか。等々。フォルダが自分自身が含まれているものなら、自分自身をもう一度開こうとしていることが想像されますが。いずれにしてももう少し説明が必要ですね。

・ツリー全体表示


	【80852】vba初心者

shizu - 19/6/1(土) 8:38 -


	引用なし

	パスワード

vba初心者です。
　複数のエクセルファイルから、指定した複数セルを1つのエクセルファイルにまとめようとしています。
以下のようなvbaを試したのですが、
デバッグが表示されます。
何が悪いのかわかりません。

ちなみに、取り込みたい複数のエクセルファイル、1つにまとめたいエクセルファイルは同じフォルダ内にあります。

Sub tenki()
　　Dim folder As String
　　Dim file As String
　　Dim book As Workbook
　　Dim i As Integer
　　i = 2
　　
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　If .Show = True Then
　　　　　　folder = .SelectedItems(1)
　　　　End If
　　End With
　　
　　file = Dir(folder & "\*.xlsx")
　　
　　Do While file <> ""
　　
　　　　Set book = Workbooks.Open(folder & "\" & file)
　　　　
　　　　ThisWorkbook.Worksheets("Sheet1").Range("A" & CStr(i)).Value = book.Worksheets("Sheet1").Range("B3").Value
　　　　ThisWorkbook.Worksheets("Sheet1").Range("B" & CStr(i)).Value = book.Worksheets("Sheet1").Range("C3").Value
　　　　ThisWorkbook.Worksheets("Sheet1").Range("C" & CStr(i)).Value = book.Worksheets("Sheet1").Range("D3").Value
　　　　ThisWorkbook.Worksheets("Sheet1").Range("D" & CStr(i)).Value = book.Worksheets("Sheet1").Range("C4").Value
　　　　
　　　　
　　　　file = Dir()
　　　　i = i + 1
　　　　
　　　　book.Close
　　Loop
　　
End Sub

ご教授　宜しくお願い致します。

・ツリー全体表示


	【80851】web クエリの高速化

よし - 19/6/1(土) 2:10 -


	引用なし

	パスワード

VBA初心者です。
現在、全国保険者情報一覧というウェブページから保険者種別ごとにマクロ１でクエリデータをシートに貼り付け、マクロ２でマクロ１で貼り付けたデータの保険者番号を元に詳細情報ウェブページにアクセスし、を貼付シートを作成しそこに一時的貼り付け、必要箇所をコピして保険者番号の横にペーストしたら、今度はその下の保険者番号を元に詳細情報ウェブページにアクセスし、先ほどの貼付シートに上書きし、必要箇所をコピして保険者番号番号の横にペーストするというループマクロを組んだのですが、マクロ１はそれなりにすぐにおわりますが、マクロ２は保険者種別にもよりますが、件数が多いもので3000ぐらいあり、処理が終わるのに２時間ほどかかります。

このwebクエリマクロを早くする方法をご教授いただけないでしょうか。

実際に使用しているマクロは下記のとおりです。
注釈：URLは保険者番号を変えるだけでそれぞれの詳細情報ウェブページにアクセスできることから、セルに保険者番号のぞくURL入力し、そのセルを元にURLを組み合わせてアクセスしています。

Sub 詳細情報取込み介護保険除く()

'確認ボタン
Dim rc As Integer
rc = MsgBox("この作業は数時間を要します。(途中で止めることもできません)実行しますか？", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
　　MsgBox "処理を行います。「終わりました」と表示されるまで触らないで下さい"

'高速化
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'シート名の取得（SNはSheetNameの略）
　　Dim SN As String
　　SN = ActiveSheet.Name
　　
'繰り返し準備（HNは保険者HokenjaNumberの略また回数の定義としても使用）
HN = 2
Do Until Cells(HN, 1) = ""
　　
'URL取得(KURLはKobetsuURLの略)
　　Dim KURL As String
　　KURL = "URL;" & Sheets("保険者一覧").Cells(2, 3) & Sheets(SN).Cells(HN, 1) & Sheets("保険者一覧").Cells(2, 4)

'データ取り込み
　　Sheets("貼付シート").Activate
　　Application.CutCopyMode = False
　　With ActiveSheet.QueryTables.Add(Connection:= _
　　　　KURL, Destination:=Range( _
　　　　"$A$1"))
　　　　.Name = "dt01010016"
　　　　.FieldNames = True
　　　　.RowNumbers = False
　　　　.FillAdjacentFormulas = False
　　　　.PreserveFormatting = True
　　　　.RefreshOnFileOpen = False
　　　　.BackgroundQuery = False
　　　　.RefreshStyle = xlOverwriteCells
　　　　.SavePassword = False
　　　　.SaveData = True
　　　　.AdjustColumnWidth = True
　　　　.RefreshPeriod = 0
　　　　.WebSelectionType = xlEntirePage
　　　　.WebFormatting = xlWebFormattingNone
　　　　.WebPreFormattedTextToColumns = True
　　　　.WebConsecutiveDelimitersAsOne = True
　　　　.WebSingleBlockTextImport = False
　　　　.WebDisableDateRecognition = False
　　　　.WebDisableRedirections = False
　　　　.Refresh BackgroundQuery:=False
　　　　.Delete
　　End With
　　
　　'詳細情報の転記
　　Sheets(SN).Cells(HN, 4) = Sheets("貼付シート").Range("A10")
　　Sheets(SN).Cells(HN, 5) = Sheets("貼付シート").Range("A12")
　　Sheets(SN).Cells(HN, 6) = Sheets("貼付シート").Range("A14")
　　Sheets(SN).Activate
　　
　　 '項目作成
　　 Range("D1") = "郵便番号"
　　 Range("E1") = "住所"
　　 Range("F1") = "電話番号"
　　
　　'回数増やす
　　HN = HN + 1
Loop

'確認ダイアログ表示
Application.DisplayAlerts = True

'高速化停止
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "終わりました。"

Else
　　MsgBox "処理を中断します。"
　　
End If

End Sub

・ツリー全体表示


	【80850】Userformの挿入、削除してませんか？

Jaka - 19/6/1(土) 1:31 -


	引用なし

	パスワード

なんとなくだけど、流れからしてUserformの挿入、削除を繰り返してませんか？
１５年ぐらい前の記憶なので、おぼろげだけど。
１回目はＯＫ、２回目でエラーとか。

１度挿入削除をやって、上書き保存するとそのブックはだめだった様な・・・。
削除しても、フォーム情報がへんな形で残ってしまって、２度目でこける。
こんな感じじゃないですか？
解決策は見つけられなかったような気が・・・。

・ツリー全体表示


	【80849】Re:エクセル　userformのイニシャライズ...

γ - 19/5/31(金) 9:39 -


	引用なし

	パスワード

バグはありません、と断言していますが、
バグっているから、.Showでエラーになっているものと思料。

オプションのエラートラップは、３つの選択肢がありますが、
3番目のものに指定していませんか？
これを、一時的に、最初の
・エラー発生時に中断
に変更してみると、実際のエラー箇所が表示されて止まるはずです。
ただし、これはデバッグ用のものなので、バグ解決後、
元の選択肢に戻しておいたほうがよいと思います。
（後半部分は想像です。実際に確認していません。あしからず）

・ツリー全体表示


	【80848】Re:エクセル　userformのイニシャライズ...

Jaka - 19/5/30(木) 23:37 -


	引用なし

	パスワード

▼Jaka さん：
>他、VBプロジェクトうんぬんの方は・・・・。
>（どこにあるのか覚えてないけど。）
>これが、触れないような状態だとエラーになると思います。

あ、消せるからこの辺は問題ないのか？

注）
下手に↑のスレを削除すると、ここ（Excel VBA質問箱）の書き込みログに白紙のファイルが残ってしまって、これが削除されるまでここにアクセスできなくなる場合があるようなので残しておきます。

・ツリー全体表示


	【80847】Re:エクセル　userformのイニシャライズ...

Jaka - 19/5/30(木) 23:27 -


	引用なし

	パスワード

他、VBプロジェクトうんぬんの方は・・・・。
（どこにあるのか覚えてないけど。）
これが、触れないような状態だとエラーになると思います。

・ツリー全体表示


	【80846】Re:エクセル　userformのイニシャライズ...

Jaka - 19/5/30(木) 22:39 -


	引用なし

	パスワード

▼のりさん：
>そこで、F8で１ステップ毎に実行したところ、
>userform8側のコードも全てクリアするのですが、
>前記コードのend　subでエラーになります。
>何がいけないのか、見当もつきません。

これは、F8ステップ実行しないでください。
エラーになります。

・ツリー全体表示


	【80845】Re:エクセル　userformのイニシャライズ...

のり - 19/5/30(木) 22:33 -


	引用なし

	パスワード

早速の書き込みに感謝いたします。
ありがとうございます。
コードですが、次に出社する５日後の火曜日に載せさせて頂きます。
当初は、userform8.show
としても何の問題もなく正常に動作していました。
その後、モジュール側のコードを付け足していきましたところ、
今までエラーがでなかった、userform8.show
のところでエラーが出るようになりました。
userform8のコードは変更していないのでバグはないと考えております。
黄色くなるのは、モジュール側のコードのuserform8です。
そこで、F8で１ステップ毎に実行したところ、
userform8側のコードも全てクリアするのですが、
前記コードのend　subでエラーになります。
何がいけないのか、見当もつきません。

▼Jaka さん：
>F8ステップ実行でですか・・・、
>
>例えば
>userform1.Show
>すると、
>
>Private Sub UserForm_Initialize()
>これが黄色くなるという感じでしょうか？
>
>>しかし、userformのコードにバグはありません。
>
>コード見ないと何とも言えないので、コードを載せた方がいいと思います。
>F8ステップ実行でのみでエラーだとすると、山勘だとマクロをいじるコードとか？

・ツリー全体表示


	【80844】Re:エクセル　userformのイニシャライズ...

Jaka - 19/5/30(木) 20:39 -


	引用なし

	パスワード

F8ステップ実行でですか・・・、

例えば
userform1.Show
すると、

Private Sub UserForm_Initialize()
これが黄色くなるという感じでしょうか？

>しかし、userformのコードにバグはありません。

コード見ないと何とも言えないので、コードを載せた方がいいと思います。
F8ステップ実行でのみでエラーだとすると、山勘だとマクロをいじるコードとか？

・ツリー全体表示


	【80843】エクセル　userformのイニシャライズ時の...

のり - 19/5/30(木) 16:32 -


	引用なし

	パスワード

userformをイニシャライズするとエラーがでます。
しかし、userformのコードにバグはありません。
Ｆ８キーで１ステップ毎に実行すると、
userformの最後のコードまで進んだ後、
End Subのところでエラーがでます。
userformは、きちんと表示されていますが、
デバッグモードになります。
どうして、でしょうか？
行き詰って、困っています。
どうか、ご回答、よろしくお願い致します。

・ツリー全体表示


	【80842】Re:フォルダ「data」内のエクセルファイ...

ようじ

- 19/5/25(土) 19:06 -


	引用なし

	パスワード

Yahoo知恵袋

エクセルの学校

にて同時に質問させて頂いてます

・ツリー全体表示


	【80841】Re:フォルダ「data」内のエクセルファイ...

ようじ

- 19/5/25(土) 18:57 -


	引用なし

	パスワード

すみません。ルールを存じ上げず大変失礼しました。

・ツリー全体表示


	【80840】Re:フォルダ「data」内のエクセルファイ...

マナ - 19/5/25(土) 18:09 -


	引用なし

	パスワード

▼ようじさん：

あちこちに質問されているので
お急ぎなのかと思いましたが
そうでもないようですね。

マルチポストに関する基本方針です。
ご一読ください。

------
マルチポストについて
別のサイト（掲示板）にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。当質問箱では、マルチポストは原則認めています。つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。

しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。

また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。

・ツリー全体表示


	【80839】フォルダ「data」内のエクセルファイルを...

ようじ

- 19/5/25(土) 15:15 -


	引用なし

	パスワード

デスクトップ内のフォルダ「data」内のエクセルファイルを開いて(転記先)転記元に転記するVBAを組みたいので、教えていただけますと幸いです。

方法
デスクトップ内のフォルダ「data」内のすべてのエクセルファイルを開く
↓
データを転記する（転記するセルの場所は一緒）
↓
名前を付けて別フォルダに保存
(保存先はデスクトップのdata2という場所)
(名前は転記元のBA124とBA125を指定して名前を付ける)
請求書_BA124_BA125.xisx
↓
loop処理（フォルダ内のエクセルファイル全て）

自分のマクロ（エラーが出てしまい詰まってしまいました）

Sub 転記先()

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim f As File
For Each f In fso.GetFolder(ThisWorkbook.Path & "\data").Files
Debug.Print f.Path
With Workbooks.Open(f.Path)
With .Worksheets(1)

with ws

wsData.Range("AZ8").Value = .Range("AZ8").Value

wsData.Range("AS16:AS22").Value = .Range("AS16:AS22").Value

end with

ActiveWorkbook.SaveAs Filename:=請求書_ & "_" ＆ "BA125" & "BA124" xisx

ActiveWorkbook.Close False

Loop

End sub

・ツリー全体表示


	【80838】Re:ゲーム制作：自機の操作と敵機の自動...

亀マスター - 19/5/23(木) 0:59 -


	引用なし

	パスワード

シューティングゲームのようなものを作ろうとしているのだと思います。

大体の感じですが、以下のようにすればいいと思います。

Do
　　'キーボードの入力状況に応じて自機の座標（i, j）を変更
　　'敵機の座標（I, J）を変更
　　'すべてのセルの背景色をクリア
　　'自機、敵機の座標のセルの背景色を設定
Loop

すべてのセルはCellsで取得できます。

ループのたびにセルの背景色をクリア・設定しているのは、自機・敵機が動いたかどうかでセルの背景色を変更するかどうかを判定していると、処理が煩雑になるためです。
ですので、ここでは自機・敵機の座標が変わったかどうかに関係なく、ループのたびに背景色を設定し直すという方法をとっています。

自機と敵機の処理を別のプロシージャにしたいなら、それぞれのプロシージャではキーボードの入力状況や乱数による座標の変更だけの処理にして、ループや背景色の設定に関しては呼び出し元で処理するようにすればいいでしょう。

なお、質問の部分ではありませんが、敵機の移動部分でRndを使う際、この関数は呼び出すたびに違う値を返すので、If x < Rnd で呼ばれるたびに違う値が使われ、思った挙動にならない可能性がありますよ。
そうしたくないなら、Rndを呼び出すのはループの中で1回だけにして、取得した値を変数にセットし、その変数を用いて条件判定すればいいと思います。

・ツリー全体表示


	【80837】Re:複数のシートに同じ処理をしたい

γ - 19/5/22(水) 23:24 -


	引用なし

	パスワード

既にポイントをついた回答を頂いています。
以下、蛇足です。

例です。
Sub Sample2()
　　Dim k　 As Long
　　Dim ws　As Worksheet
　　Dim rng As Range
　　
　　'左から1番目から3番目のシートを繰り返す
　　For k = 1 To 3
　　　　Set ws = Worksheets(k)
　　　　For Each rng In ws.Range("B2:E20").Rows
　　　　　　If WorksheetFunction.CountA(rng) = 0 Then rng.EntireRow.Hidden = True
　　　　Next rng
　　Next
End Sub

Sub Sample3()
　　Dim s As Variant
　　Dim ws　As Worksheet
　　Dim rng As Range
　　Dim k As Long
　　
　　'シート名を列挙する方式
　　For Each s In Array("Sheet1", "Sheet2")
　　　　Set ws = Worksheets(s)
　　　　For Each rng In ws.Range("B2:E20").Rows
　　　　　　If WorksheetFunction.CountA(rng) = 0 Then rng.EntireRow.Hidden = True
　　　　Next rng
　　Next
End Sub

・ツリー全体表示


	【80836】Re:複数のシートに同じ処理をしたい

マナ - 19/5/22(水) 23:02 -


	引用なし

	パスワード

▼sakana さん：

すべてのシートに繰り返し処理する場合は、

Sub test()
　　Dim ws As Worksheet
　　
　　For Each ws In Worksheets
　　　　MsgBox ws.Range("B2").Value
　　Next
　　
End Sub

・ツリー全体表示


	【80835】複数のシートに同じ処理をしたい

sakana - 19/5/22(水) 22:24 -


	引用なし

	パスワード

超初心者です。

選択した範囲の行が空欄だった場合、非表示にするというコードがうまくいったのですが、複数シートに同じ処理をする方法がわかりません。

Sub Sample2()
Dim Rng As Range
Worksheets("sheet1").Select

For Each Rng In Range("B2:E20").Rows
If WorksheetFunction.CountA(Rng) = 0 Then Rng.EntireRow.Hidden = True
　Next Rng
end sub

上のコードをどう書き換えたらいいのでしょうか？
よろしくお願いします

・ツリー全体表示


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

81 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free