Excel VBA質問箱 IV

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

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


77 / 3841 ページ ←次へ | 前へ→

【80934】Re:2回に1回エラーが出る
発言  マナ  - 19/6/23(日) 20:04 -

引用なし
パスワード
   ▼さと さん:

>このように2回に1回エラーが出ます。

この原因はわかりませんが

a-6が、1以上でないとエラー
b-1も、1以上でないとエラー

です。Resizeできないので。

あと、7月シートがactiveでないとエラーになります。
・ツリー全体表示

【80933】2回に1回エラーが出る
質問  さと  - 19/6/23(日) 19:23 -

引用なし
パスワード
   マクロ初心者です。
調べても原因が分かりませんでした。
原因が分かる方がいましたら、教えていただきたいです。

1回目にマクロを実行すると「エラー1004」が出ます。
エラー画面で終了を押して、もう一度実行するとエラーが出ず、処理が完了します。
3回目もエラーが出て、4回目はうまくいきます。
このように2回に1回エラーが出ます。

エラーが出るのは、以下のコードです。

Option Explicit

Sub 当月入力準備()
  Application.ScreenUpdating = False
  Dim a As Long, b As Long
  a = Selection.Rows.Count
  b = Selection.Columns.Count
  With Sheets("7月")
    .Range("B2").CurrentRegion.Offset(2, 1).Select
    Selection.Resize(a - 3, b - 1).Select
    Selection.Copy
    .Range("B2").CurrentRegion.Offset(3, 1).Select
    Selection.Resize(a - 3, b - 1).Select
    Selection.PasteSpecial xlPasteValues
    .Range("B2").CurrentRegion.Offset(2, 1).Select
    Selection.Resize(a - 6, b - 1).Select
    Selection.ClearContents
  End With
End Sub
・ツリー全体表示

【80932】Re:数値が入っていない行を削除する
発言  マナ  - 19/6/22(土) 9:22 -

引用なし
パスワード
   ▼と金 さん:

フィルターで空白セルのみ抽出して削除
という方法もあります。
・ツリー全体表示

【80931】Re:数値が入っていない行を削除する
発言  マナ  - 19/6/21(金) 19:43 -

引用なし
パスワード
   ▼と金 さん:

>C列の単価には数値が入っている列と入っていない列が混在する時
>数値が入っていない行を削除するにはどうしたらいいでしょうか?

1)C列を選んで、ジャンプ機能で空白セルを選択
2)行全体を削除

>シート1〜シート10まで同時に消す場合もお教え下さい

同じこと、各シートで繰り返せばよいです。
わたしなら、手作業でやっちゃいますが、
マクロでも同じ手順で考えると良いです。
・ツリー全体表示

【80930】数値が入っていない行を削除する
質問  と金  - 19/6/21(金) 19:22 -

引用なし
パスワード
   ご教授ください
シート1に単純な表、たとえば1行〜30行、A列が名称、B列が数量、C列が単価、〜D列が金額
というシートが有るとします

C列の単価には数値が入っている列と入っていない列が混在する時
数値が入っていない行を削除するにはどうしたらいいでしょうか?


シート1〜シート10まで同時に消す場合もお教え下さい
宜しくお願い申し上げます
・ツリー全体表示

【80929】Re:グラフ書式の統一
発言  マナ  - 19/6/21(金) 19:10 -

引用なし
パスワード
   ▼しょしんしゃ さん:

書式をコピーするのではなく、
コピーしたい書式を、マクロで設定できないのですか。
・ツリー全体表示

【80928】Re:指定のシートがあれば処理を行い、無...
発言  Jaka  - 19/6/21(金) 15:04 -

引用なし
パスワード
   あまりよく見てないけど・・・・。

>  If flag = False Then Close
             ↑
          .が足りない。
・ツリー全体表示

【80927】Re:指定のシートがあれば処理を行い、無...
発言  Jaka  - 19/6/21(金) 14:54 -

引用なし
パスワード
   flag が立ったら、ずっと立ちっぱなしなので、どこかで下す必要があるのでは。
・ツリー全体表示

【80926】指定のシートがあれば処理を行い、無けれ...
質問  fika  - 19/6/21(金) 14:06 -

引用なし
パスワード
   行き詰りました。。お知恵をお借りできたら嬉しいです。

1つのフォルダに複数のブックにあり、
そのブックの中で、特定のシートにあるレコードだけを1つのブックに
コピぺで集約していくマクロを作成しています。

シートが有るか無いかをflagを使って処理をしようと入れてみました。
一番最初に該当するシートが無いブックに当たった場合は、処理ができたのですが、途中に該当するシートが無いブックにがあると、
「実行時エラー9、インデックスが有効範囲にありません。」となり、
ウォッチで見ると、flag の値が empty になっていました。
flag の値を空にする処理が必要なのでしょうか。。

以下がVBAになります。
宜しくお願い致します!

<行いたい処理>
ブックの中に、シートAがあったら値を集約先にコピーする処理、
なかったら次のブックに進む。

<VBA>
============================================
Sub 集約()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim pass As String
pass = ThisWorkbook.Path & "\ファイルの保存先"
Dim i As Long, j As Long

j = 2
Dim f As File
Dim ws As Worksheet
Dim flag As Boolean

For Each f In fso.GetFolder(pass).Files
  With Workbooks.Open(f)
  
  For Each ws In Worksheets
   If ws.Name = "A" Then flag = True
  Next ws
  If flag = False Then Close
  If flag = True Then
   
   With .Worksheets("A")
    
       i = 2
      Do While .Cells(i, 1).Value <> ""  
        Sheet1.Cells(j, 1).Value = .Cells(i, 1).Value 
        Sheet1.Cells(j, 2).Value = .Cells(i, 2).Value 
        Sheet1.Cells(j, 3).Value = .Cells(i, 3).Value 
        Sheet1.Cells(j, 4).Value = .Cells(i, 4).Value 
        Sheet1.Cells(j, 5).Value = .Cells(i, 5).Value 
        Sheet1.Cells(j, 6).Value = .Cells(i, 6).Value 
        Sheet1.Cells(j, 7).Value = .Cells(i, 7).Value 
        Sheet1.Cells(j, 8).Value = .Cells(i, 8).Value 
        Sheet1.Cells(j, 9).Value = .Cells(i, 9).Value 
        Sheet1.Cells(j, 9).Value = .Cells(i, 10).Value 
        i = i + 1
        j = j + 1
      Loop
    End With
  Set ws = Nothing

  End If
     
    .Close
  End With
  
Next f
End Sub
・ツリー全体表示

【80925】Re:グラフ書式の統一
質問  しょしんしゃ  - 19/6/21(金) 13:49 -

引用なし
パスワード
   昨日投稿した内容の続きです。
マナさんのご回答より、Excel動作停止の原因は、
使用しているグラフに含まれているエラーバーの可能性が非常に高いです。

そこで、処理として以下の流れにすることで
Excel動作停止を避けたいと考えています。

【VBA内容】
1.ActiveChartのエラーバーの設定値取得
2.ActiveChartのエラーバーの削除
3.ActiveChartのコピー
4.For文開始
5.各グラフの残したい縦横軸、エラーバーの設定値を変数に格納
6.各グラフのエラーバー削除
7.各グラフにActiveChartの書式をコピー
8.各グラフに変数に格納した縦横軸、エラーバー設定値を反映
9.For文終了

2.のエラーバーの削除方法は分かったのですが、
1.、5.ので使用するErrorBarsプロパティの引数を取得する方法が分かりません。

ご助言のほどよろしくお願いいたします。


▼しょしんしゃ さん:
>マクロ初心者です。
>ActiveChartの書式をActiveSheet内の全グラフに反映させる
>マクロを作成いたしましたが、
>マクロ処理完了後、Excelの動作が停止してしまいます。
>
>VBAのフローに不備がございましたら、教えていただければ幸いです。
>
>【使用PCスペック】
>OS:windows10
>CPU:Core(TM)i3-6100U CPU @2.30GHz
>RAM:4GB
>
>【VBA内容】
>縦軸と横軸の最大最小値、目盛りの間隔は元の状態を維持したい為、
>
>1.ActiveChartのコピー
>2.For文開始
>3.各グラフの残したい縦横軸の設定値を変数に格納
>4.各グラフにActiveChartの書式をコピー
>5.各グラフに変数に格納した縦横軸設定値を反映
>6.For文終了
>
>といった処理を行っています。 
>
>【処理結果】
>・ActiveSheet内のグラフの書式は狙ったとおりに反映される
>・各グラフの結果を確認する為に、Excelをいじっていると
> 10秒程度たった後に動作が停止する
>
>
>【VBA】
>----------------------------------------
>Sub グラフ書式の統一()
>
>Dim objChart As Object
>Dim x_MinScale As Single
>Dim x_MaxScale As Single
>Dim y_MinScale As Single
>Dim y_MaxScale As Single
>Dim x_MjrUnit As Single
>Dim y_MjrUnit As Single
>
>
>On Error GoTo ErrorHandler
>
>
>If ActiveChart Is Nothing Then
>  MsgBox "基準となるグラフを選択した状態で実行してください"
>  Exit Sub
>End If
>
>'基準となるグラフのコピー(後に書式を貼り付け)
>ActiveChart.ChartArea.Copy
>
>
>'全てのチャートにおいて、"縦横軸の設定保持⇒基準グラフの書式貼り付け⇒元の縦横軸の設定に戻す"を繰り返す
>For Each objChart In ActiveSheet.ChartObjects
>  
>  
>  '貼り付け先のグラフの横軸の設定を取得
>  With objChart.Chart.Axes(xlCategory)
>    x_MinScale = .MinimumScale
>    x_MaxScale = .MaximumScale
>    x_MjrUnit = .MajorUnit
>    
>  End With
>  
>  '貼り付け先のグラフの縦軸の設定を取得
>  With objChart.Chart.Axes(xlValue)
>    y_MinScale = .MinimumScale
>    y_MaxScale = .MaximumScale
>    y_MjrUnit = .MajorUnit
>  End With
>  
>  
>  '基準となるグラフの書式を貼り付け
>  objChart.Select
>  ActiveSheet.PasteSpecial Format:=2
>  
>  '保持していた元の横軸設定を反映
>  With objChart.Chart.Axes(xlCategory)
>    .MinimumScale = x_MinScale
>    .MaximumScale = x_MaxScale
>    .MajorUnit = x_MjrUnit
>    
>  End With
>  
>  '保持していた元の縦軸設定を反映
>  With objChart.Chart.Axes(xlValue)
>    .MinimumScale = y_MinScale
>    .MaximumScale = y_MaxScale
>    .MajorUnit = y_MjrUnit
>  End With
>
>
>Next
>
>''''''
>
>ErrorHandler:
>Exit Sub
>
>'''''''
>
>End Sub
>-----------------------------------------------------
・ツリー全体表示

【80924】Re:グラフ書式の統一
お礼  しょしんしゃ  - 19/6/21(金) 8:15 -

引用なし
パスワード
   ▼マナ さん

また、併せてActiveChartにもPasteしている点も修正してみようと思います。

この度は誠にありがとうございました。
・ツリー全体表示

【80923】Re:グラフ書式の統一
お礼  しょしんしゃ  - 19/6/21(金) 8:13 -

引用なし
パスワード
   ▼マナ さん

エラーバー使用しておりました。
添付いただいたURLを参考に修正してみます。

ご助力いただきありがとうございました!
・ツリー全体表示

【80922】Re:グラフ書式の統一
発言  マナ  - 19/6/20(木) 22:50 -

引用なし
パスワード
   ▼しょしんしゃ さん:

そのグラフは、エラーバーを使用していますか?
こんなのがりました。
ht tps://www.reddit.com/r/excel/comments/7txu9k/excel_crashes_after_but_not_while_running_macro/
・ツリー全体表示

【80921】Re:グラフ書式の統一
発言  マナ  - 19/6/20(木) 21:15 -

引用なし
パスワード
   ▼しょしんしゃ さん:

試してみましたが、再現しません。
コードも、自分自身にまで、処理しているのは無駄な気がしますが、
特に問題なさそうです。
・ツリー全体表示

【80920】グラフ書式の統一
質問  しょしんしゃ  - 19/6/20(木) 19:32 -

引用なし
パスワード
   マクロ初心者です。
ActiveChartの書式をActiveSheet内の全グラフに反映させる
マクロを作成いたしましたが、
マクロ処理完了後、Excelの動作が停止してしまいます。

VBAのフローに不備がございましたら、教えていただければ幸いです。

【使用PCスペック】
OS:windows10
CPU:Core(TM)i3-6100U CPU @2.30GHz
RAM:4GB

【VBA内容】
縦軸と横軸の最大最小値、目盛りの間隔は元の状態を維持したい為、

1.ActiveChartのコピー
2.For文開始
3.各グラフの残したい縦横軸の設定値を変数に格納
4.各グラフにActiveChartの書式をコピー
5.各グラフに変数に格納した縦横軸設定値を反映
6.For文終了

といった処理を行っています。 

【処理結果】
・ActiveSheet内のグラフの書式は狙ったとおりに反映される
・各グラフの結果を確認する為に、Excelをいじっていると
 10秒程度たった後に動作が停止する


【VBA】
----------------------------------------
Sub グラフ書式の統一()

Dim objChart As Object
Dim x_MinScale As Single
Dim x_MaxScale As Single
Dim y_MinScale As Single
Dim y_MaxScale As Single
Dim x_MjrUnit As Single
Dim y_MjrUnit As Single


On Error GoTo ErrorHandler


If ActiveChart Is Nothing Then
  MsgBox "基準となるグラフを選択した状態で実行してください"
  Exit Sub
End If

'基準となるグラフのコピー(後に書式を貼り付け)
ActiveChart.ChartArea.Copy


'全てのチャートにおいて、"縦横軸の設定保持⇒基準グラフの書式貼り付け⇒元の縦横軸の設定に戻す"を繰り返す
For Each objChart In ActiveSheet.ChartObjects
  
  
  '貼り付け先のグラフの横軸の設定を取得
  With objChart.Chart.Axes(xlCategory)
    x_MinScale = .MinimumScale
    x_MaxScale = .MaximumScale
    x_MjrUnit = .MajorUnit
    
  End With
  
  '貼り付け先のグラフの縦軸の設定を取得
  With objChart.Chart.Axes(xlValue)
    y_MinScale = .MinimumScale
    y_MaxScale = .MaximumScale
    y_MjrUnit = .MajorUnit
  End With
  
  
  '基準となるグラフの書式を貼り付け
  objChart.Select
  ActiveSheet.PasteSpecial Format:=2
  
  '保持していた元の横軸設定を反映
  With objChart.Chart.Axes(xlCategory)
    .MinimumScale = x_MinScale
    .MaximumScale = x_MaxScale
    .MajorUnit = x_MjrUnit
    
  End With
  
  '保持していた元の縦軸設定を反映
  With objChart.Chart.Axes(xlValue)
    .MinimumScale = y_MinScale
    .MaximumScale = y_MaxScale
    .MajorUnit = y_MjrUnit
  End With


Next

''''''

ErrorHandler:
Exit Sub

'''''''

End Sub
-----------------------------------------------------
・ツリー全体表示

【80919】Re:フォームの読み込みが上手く行きません
お礼  サンライズ  - 19/6/20(木) 8:14 -

引用なし
パスワード
   ▼よろずや様
>set は、オブジェクトに対して使います。
>gyo も retu もオブジェクトではないので、set は不要です。

ありがとうございます!
無事、処理が上手くいきました!
・ツリー全体表示

【80918】Re:フォームの読み込みが上手く行きません
回答  よろずや  - 19/6/20(木) 7:06 -

引用なし
パスワード
   ▼サンライズ さん:
>Private Sub UserForm_initialize()
>
>  Dim gyo%
>  Dim retu%
>
>  Set gyo = ActiveCell.Row
>  Set retu = Range("金額").Column
>  txt金額.Value = Cells(gyo, retu).Value
>  
>  
>End Sub

set は、オブジェクトに対して使います。
gyo も retu もオブジェクトではないので、set は不要です。
・ツリー全体表示

【80917】フォームの読み込みが上手く行きません
質問  サンライズ  - 19/6/20(木) 5:36 -

引用なし
パスワード
   背景
エクセル上で数式の管理から名前付セル"金額"を作成しています。
選択しているセルの行にある"金額"列の
金額が表示され、ユーザフォーム上のテキストボックスで修正を行えるようにしたつもりでした。
類似のユーザフォームを作って他は動いているのですが、
これだけ起動時にエラーが出ます。
何故かわからないでしょうか?


Private Sub UserForm_initialize()

  Dim gyo%
  Dim retu%

  Set gyo = ActiveCell.Row
  Set retu = Range("金額").Column
  txt金額.Value = Cells(gyo, retu).Value
  
  
End Sub
・ツリー全体表示

【80916】Re:SUMPRODUCT関数をVBAに書き起こす
お礼  猫の下僕  - 19/6/18(火) 17:38 -

引用なし
パスワード
   Jaka様
ありがとうございます。

(1)を(2)にしたところ結果を得られました。

(1)Cells(i, "J") = Application.Evaluate("SumProduct(((J38:CE68) = (F" & i & ").Value) * ((J5:CE35) = ""T"") * (J1:CE1))")

(2)Cells(i, "J") = Application.Evaluate("SumProduct(((J38:CE68) = (F" & i & ")) * ((J5:CE35) = ""T"") * (J1:CE1))")
・ツリー全体表示

【80915】Re:SUMPRODUCT関数をVBAに書き起こす
発言  Jaka  - 19/6/18(火) 16:59 -

引用なし
パスワード
   >Cells(i, "J") = Application.Evaluate("SumProduct(((J38:CE68) = (F" & i & ").Value) * ((J5:CE35) = ""T"") * (J1:CE1))")

まず、セルなどに書き込んで数式が合っているのか自分で確認しましょう。

Range("A1").Value = "SumProduct(((J38:CE68) = (F" & i & ").Value) * ((J5:CE35) = ""T"") * (J1:CE1))"
・ツリー全体表示

77 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free