Excel VBA質問箱 IV

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

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


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

82 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【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

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

・ツリー全体表示


	【80834】ゲーム制作：自機の操作と敵機の自動移動...

ＳＨＵＮ - 19/5/21(火) 13:26 -


	引用なし

	パスワード

VBAで自機を動かすプログラム、敵機を自動で移動するプログラムはそれぞれ組めましたが、
その２つを同時に動かす段階で躓いています。

Call '自機を動かすプログラム=aとします。
Call ’敵機を動かすプログラム=bとします。
とすると、aのプログラム終了後にbのプログラム処理となり、
１つのプロシージャ内に両方入れようとすると上手くいきません。

参考に、それぞれのソースを以下に貼り付けます。

Sub 自機発生()

Dim i As Integer
Dim j As Integer

Dim i2 As Integer
Dim j2 As Integer

Cells.Interior.ColorIndex = xlNone

　　i = 10
　　j = 10
　　
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　
　Do
　
　　　　'自機発生、操作
　　　　
　　　　If GetAsyncKeyState(37) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If j <= 3 Then
　　　　　　j = 17
　　　　　　Else
　　　　　　j = j - 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(38) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If i <= 3 Then
　　　　　　i = 17
　　　　　　Else
　　　　　　i = i - 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(39) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If j >= 17 Then
　　　　　　j = 3
　　　　　　Else
　　　　　　j = j + 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(40) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If i >= 17 Then
　　　　　　i = 3
　　　　　　Else
　　　　　　i = i + 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(13) <> 0 Then
　　　　
　　　　Exit Do
　　　　
　　　　End If
　　　　
　　DoEvents

　　Sleep 90
　　
　　Loop

End Sub

Sub 発生()
　　Dim i As Integer
　　Dim j As Integer

　　Randomize
　　

　　i = 3
　　j = 15
　　
　　Do
　　
　　'敵機発生、ランダムで移動
　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone

　　　　
　　If 0 <= Rnd And Rnd < 0.25 Then
　　　　If i >= 17 Then
　　　　i = 3
　　　　Else
　　　　i = i + 1
　　　　End If
　　Else
　　If 0.25 <= Rnd And Rnd < 0.5 Then
　　　　If j >= 17 Then
　　　　j = 3
　　　　Else
　　　　j = j + 1
　　　　End If
　　Else
　　If 0.5 <= Rnd And Rnd < 0.75 Then
　　　　If i <= 3 Then
　　　　i = 17
　　　　Else
　　　　i = i
　　　　End If
　　Else
　　If 0.75 <= Rnd And Rnd < 1 Then
　　　　If j <= 3 Then
　　　　j = 17
　　　　Else
　　　　j = j - 1
　　　　End If
　
　　Cells(i, j).Interior.ColorIndex = 3
　　
　　End If
　　
　　　　 If GetAsyncKeyState(13) <> 0 Then
　　　　
　　　　 Exit Do
　　　　
　　　　 End If
　　
　　DoEvents
　　
　　
　　Sleep 90

　Loop

End Sub

よろしくお願いいたします。

・ツリー全体表示


	【80833】Re:f2+enterをマクロを使って押させたい

Mp - 19/5/20(月) 13:06 -


	引用なし

	パスワード

返信遅くなり申し訳ございません

無事にリンクを挿入できました。
ありがとうございました。

▼マナさん：
>▼Mp さん：
>
>>ブックAのセルにあるフォルダのパスを読み込んで、ブックBに貼り付けました。
>>そのあとそのパスをf2+enterで水色？に表示させてクリックしたらそのフォルダを開けるようにしたいです。
>
>こことかを参考になりませんか
>ht　tps://excelwork.info/excel/hyperlinks/
>
>

・ツリー全体表示


	【80832】Re:［無題］

しいな - 19/5/19(日) 22:53 -


	引用なし

	パスワード

▼マナさん：
マナさんご丁寧にありがとうございました。今VBAの本と照らし合わせながら、こうやって作っていくんだと勉強させていただいています。
本当に奥が深くて勉強になります。ありがとうございました。

>▼しいなさん：
>
>ごめんなさい。毎回ピボットを作り直す必要なかったです。
>最初に、手作業で作っておけば、
>
>ws.Cells(9).PivotTable.SourceData = r.Address(, , xlR1C1, True)
>
>これだけで十分でした。

・ツリー全体表示


	【80831】Re:十字キーで色をつけたセルの移動の方法

ＳＨＵＮ - 19/5/18(土) 12:38 -


	引用なし

	パスワード

ありがとうございます。
初心者なのでユーザーフォームとは？となってしまいましたが、
別解も理解したほうが後々幅が広がると思うので、勉強しようと思います。
ありがとうございました。

・ツリー全体表示


	【80830】Re:十字キーで色をつけたセルの移動の方法

ＳＨＵＮ - 19/5/18(土) 12:37 -


	引用なし

	パスワード

亀マスターさん

ありがとうございます。
以下のように組んでみたところ、上手くいきました。ありがとうございました。

　　i = 10
　　j = 10
　　
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　
　Do
　　　　'自機発生、操作
　　　　
　　　　If GetAsyncKeyState(37) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If j <= 3 Then
　　　　　　j = 17
　　　　　　Else
　　　　　　j = j - 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(38) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If i <= 3 Then
　　　　　　i = 17
　　　　　　Else
　　　　　　i = i - 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(39) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If j >= 17 Then
　　　　　　j = 3
　　　　　　Else
　　　　　　j = j + 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(40) <> 0 Then
　　　　
　　　　Cells(i, j).Interior.ColorIndex = xlNone
　　　　　　If i >= 17 Then
　　　　　　i = 3
　　　　　　Else
　　　　　　i = i + 1
　　　　　　End If
　　　　Cells(i, j).Interior.ColorIndex = 6
　　　　
　　　　End If
　　　　
　　　　If GetAsyncKeyState(13) <> 0 Then
　　　　
　　　　Exit Do
　　　　
　　　　End If
　　　　
　　DoEvents
　　
　　Sleep 90
　　
　　Loop
　　

End Sub

・ツリー全体表示


	【80829】Re:フォルダ内のファイル名の変更につい...

γ - 19/5/18(土) 8:56 -


	引用なし

	パスワード

以下のようなコードでステップ実行をするとわかりますが、
getdataが呼ばれるのは一回だけですから、
更新の結果がさらに入力に影響することはあり得ないと思います。

したがって、
一回のループで、1つのファイルに更新が二回されることはないはずです。

Function getdata() As Variant
　　Dim fso As New FileSystemObject
　　Set getdata = fso.GetFolder("F:\新しいフォルダー").Files
End Function

Sub ファイル名変更()
　　Dim myfile As file
　　For Each myfile In getdata
　　　　Debug.Print myfile.Name
　　Next myfile
End Sub

・ツリー全体表示


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

82 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free