Excel VBA質問箱 IV

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

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


15 / 3840 ページ ←次へ | 前へ→

【82182】Re:VBA
発言  MK  - 23/8/22(火) 12:15 -

引用なし
パスワード
   23/8/22(火) 10:54の事例ですと、データが1と2だけの場合、
1と2は相殺関係にありますが、最新の計上日は残すので
相殺しない、ということでいいですか?
・ツリー全体表示

【82181】Re:VBA
質問  いとう  - 23/8/22(火) 10:54 -

引用なし
パスワード
   MK様返信ありがとうございます。
ご質問ですが一対一の相殺関係です。

申し訳ありませんが、昨日の表がわかりにくかったことに加え変更がございます。
計上日を追加しました。最新の計上日を残しそれ以外を一対一の関係で相殺したいです。文系女子にはもうお手上げ状態です。

   A   B     C  D
  品目CD 計上日   単価 金額
1 ばなな 2022/8/31  110  110
2 ばなな 2022/8/31  100 -100
3 ばなな 2022/8/2   100  100

ご面倒をお掛けしますが、よろしければご回答をお願いいたします。
・ツリー全体表示

【82180】Re:VBA
発言  MK  - 23/8/22(火) 10:38 -

引用なし
パスワード
   事例では、2と3、4と5というように一対一の相殺関係にありますが、
一対二、二対三というような相殺もありますか?
・ツリー全体表示

【82179】VBA
質問  いとう  - 23/8/21(月) 17:07 -

引用なし
パスワード
      A   B   C
  品目  単価 合計
1 りんご 110  110
2 りんご 100  -100
3 りんご 100  100
4 りんご  50   50
5 みかん  50   50


「品目」「単価」が一致、かつ2行目3行目のように相殺している行を
まるごと削除したいです。上記で言うと1行目しか残らないようにしたいです。

どなたか教えていただけますでしょうか。よろしくお願いいたします。
・ツリー全体表示

【82178】SSDを用いたら処理は早くなりますか?
質問  usa  - 23/8/9(水) 10:32 -

引用なし
パスワード
   教えてください。
Windows7から11へパソコンを変更したら、マクロの処理が遅くなりました。
やっている内容としては、パソコンからサーバーのmdbファイルへ読み書きをしています。
現在は通常のハードディスクのCドライブにエクセルファイルを置いていますが、これを外付けのSSDに変更するとマクロの処理は早くなるのでしょうか?
確かめたいのですが、手元にSSDがない為動作確認をすることができません。
知識がある方、教えてください。
・ツリー全体表示

【82177】Re:4桁の数値の時間データ化について
お礼  りいな E-MAIL  - 23/7/27(木) 15:01 -

引用なし
パスワード
   ありがとうございます!すごいです!!できました!
1週間色々試してダメだったので、本当に救われました。
ちょっと力技感がありますが、書ける式を足したので運用してみます。
本当にありがとうございます。

Sub test()
Dim t As String
Dim i As Long
 For i = 11 To 43
Dim g As Long
 For g = 7 To 11

  With Cells(i, g)
   t = .Value
  If Len(t) > 1 Then
   If Len(t) = 3 Then t = "0" & t
   .NumberFormatLocal = "[h]:mm"
   .Formula = Left(t, 2) & ":" & Right(t, 2)
  End If
  End With
Next
Next
End Sub
・ツリー全体表示

【82176】Re:4桁の数値の時間データ化について
発言  MK  - 23/7/27(木) 9:17 -

引用なし
パスワード
   > .NumberFormatLocal = "h:mm"

↓でお試しください。

  .NumberFormatLocal = "[h]:mm"
・ツリー全体表示

【82175】Re:4桁の数値の時間データ化について
発言  MK  - 23/7/27(木) 9:04 -

引用なし
パスワード
   [h]:mm
でしたね。

私のサンプルは24時以降の時刻には対応してません。
・ツリー全体表示

【82174】Re:4桁の数値の時間データ化について
発言  MK  - 23/7/27(木) 9:02 -

引用なし
パスワード
   参考です。

Sub test()
Dim t As String
  With ActiveCell
   t = .Value
   If Len(t) = 3 Then t = "0" & t
   .NumberFormatLocal = "h:mm"
   .Formula = Left(t, 2) & ":" & Right(t, 2)
  End With
End Sub
・ツリー全体表示

【82173】4桁の数値の時間データ化について
質問  りいな E-MAIL  - 23/7/25(火) 20:40 -

引用なし
パスワード
   書式設定なしの3桁ないし4桁の数値を[h]:mmの書式設定に変換したいです。
初心者なので色々わかる範囲で試したのですが、家庭教師に習ったのがデータの抽出までで変換がわからず、timevalueではうまくいかず…使う関数が間違っているでしょうか。
時間データとして計算しなくてはならず、数値のままだと計算が狂ってしまうのですが、調べても表示を変える方法ばかりでうまくいかないので、解決できると嬉しいです。素人が初歩的な質問ですみません。
・ツリー全体表示

【82172】Re:リストのデータ元
質問  あおこ  - 23/7/4(火) 10:54 -

引用なし
パスワード
   すみません、そもそもセルのリストって2列は設定できないんですね。

ユーザーフォームの作成は考えていないのですが、
金融機関コードの入力支援となるようなよい方法があれば
ご教示いただけると幸いです。
・ツリー全体表示

【82171】リストのデータ元
質問  あおこ  - 23/7/4(火) 10:50 -

引用なし
パスワード
   入力用シートのセルに金融機関コードを入力したときに、
当該金融機関の支店コードをリストの選択肢にしたいと考えています。

具体的には

近隣の金融機関コードと支店コード、支店名を入力した以下のような
金融機関シートが元々あるため、これを活用できればと考えています。
※支店コードは近隣のよく使用するもののみ入力されているので
 とびとびに存在しています。

  0001 0002 ・・・
1 
2    アオヤマ
3 ギンザ 
4    タバタ


55 ウエノ


900


入力シートの金融機関コードセル(F9)に 0001 が入力されたら
支店コード入力セルに(F11)に 

3 ギンザ
55 ウエノ
というリストが入るようにしたいです。       


どうやったらできるか考えたときに、
二次元配列に、支店コードと支店名を追加していって、
それをリストにセットすればよいのではと考え
以下のとおり途中まで記載しているのですが、
そもそも配列が苦手なので、ネットで調べても
応用ができず、行き詰っています。

いつもこちらの掲示板に頼ってしまっていますが、
所定の目的を達成できる方法を、ヒントでも構いませんので
ご教示いただけると幸いです。


Sub Macro1()
’試作の段階ですので、7列目の5〜最終行目にある支店名をリスト元とする処理のみ記載しています。

'
' Macro1 Macro

RETSU=5’金融機関コードの列
D_RETSU=7 ’指定の金融機関コードの存在する列
 
lastRow = Sheets("金融機関").Cells(Rows.Count, 7).End(xlUp).Row
Dim siten() As String
C = WorksheetFunction.CountA(Sheets("金融機関").Range(Sheets("金融機関").Cells(5, D_RETSU), Sheets("金融機関").Cells(lastRow, D_RETSU)))’当該金融機関コードの入力支店数
 
ReDim siten(C, 1) 
 
For i = 5 To lastRow
If Sheets("金融機関").Cells(i, D_RETSU) <> "" Then 'データがあれば、配列に追加
  
・・・ここがよくわかりません。

End If
 
Next i

’マクロの記録により記録されたコード
sheets("入力シート").Range("L11").select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=金融機関!$K$5:$K$910" ←ここに配列をセット
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeOff
.ShowInput = True
.ShowError = True
End With
  
End Sub
・ツリー全体表示

【82170】Re:ディメンションが無効
お礼  あおこ  - 23/6/20(火) 10:22 -

引用なし
パスワード
   ▼マナ さん:
>▼あおこ さん:
>
>>タイトル行、データ行、合計行のあるデータをグループ化していまして、Aはデータ行に行く処理、Bは次のグループのタイトル行に行くために記載しています。
>
>Aの行はなくても、↓のDo While 〜Loop内で、処理されると思いました。
>
>>Do While .Cells(GYO, 1).Value <> "合計" '条件を満たしている間処理を繰り返す
>>   GYO = GYO + 1
>>Loop

確かにそうですね!
もともとあるものを継ぎ足して作ることが多いので、いろいろと無駄が多い、、。

今回いろいろ教えていただき、本当に助かりました。
ありがとうございました。
・ツリー全体表示

【82169】Re:ディメンションが無効
発言  マナ  - 23/6/16(金) 21:24 -

引用なし
パスワード
   ▼あおこ さん:

>タイトル行、データ行、合計行のあるデータをグループ化していまして、Aはデータ行に行く処理、Bは次のグループのタイトル行に行くために記載しています。

Aの行はなくても、↓のDo While 〜Loop内で、処理されると思いました。

>Do While .Cells(GYO, 1).Value <> "合計" '条件を満たしている間処理を繰り返す
>   GYO = GYO + 1
>Loop
・ツリー全体表示

【82168】Re:ディメンションが無効
お礼  あおこ  - 23/6/16(金) 10:58 -

引用なし
パスワード
   ▼マナ さん:
>>当初問題なく動いていたのですが、突然
>> cho.Copy のところで
>>「指定したディメンションは、このグラフの種類では無効です。」
>>のエラーが出るようになりました。(再実行すれば作成されますし、出ないときもあります。)
>>  Set cho = sh_A3.ChartObjects(1).Duplicate.Parent 'コピー元のグラフを複製
>
>DoEventsをこの次に移動あるいは追加してみてはどうでしょうか。
追加してみました。

全学校分のグラフを作るコードと、指定学校分を作るコードの2種類をグラフ元のデータ作成箇所以外、同じコードで作っておりまして、
よくよく調べたら、全学校分の方のみエラーが出ておりましたので、
改めて見比べたら、
Dim cho As ChartObjectを記載していませんでした。
記載したら発生しなくなりましたが、これが原因でしょうか。
いずれにせよ、宣言を忘れないようにします。

>>
>>それから、下記のコードでは、まれに応答なしになって落ちるため、
>
>同じデータで、応答なしになるのでしょうか。
そうだったのです・・。

>>コードの問題点等あればご指摘いただけませんでしょうか。
>
>>   GYO1 = GYO ' グループの先頭行→GYO1
>>   GYO = GYO + 1    ←この行は必要でしょうか?
>
Do While .Cells(GYO, 1).Value <> ""
GYO1 = GYO ' グループの先頭行→GYO1
GYO = GYO + 1 ←A
' 次の行から同じグループでない行を見つける
Do While .Cells(GYO, 1).Value <> "合計" '条件を満たしている間処理を繰り返す
   GYO = GYO + 1
Loop
GYO2 = GYO  ' 同じグループの最終行→GYO2
GYO = GYO + 1 ←B
〜省略〜
Loop

タイトル行、データ行、合計行のあるデータをグループ化していまして、Aはデータ行に行く処理、Bは次のグループのタイトル行に行くために記載しています。
元々 A学校のデータが複数行、B学校のデータが複数行、・・とあるときに、A学校のデータをグループ化するということをしたくて、ネットで見つけたコードです。
よく使用しているので、応用して作っておりますが、良い方法があれば教えていただけると幸いです。
      (1列)
(タイトル行)質問  
(データ行)A学校名
(データ行)B学校名
(データ行) ・
(データ行) ・
(合計行)  合計
※全学校分のデータ例 
※指定学校分は 「質問、A学校名、合計」の3行のデータ構成だが、今後、選択した複数校のデータをもとにグラフ化したいため、汎用性のあるグループ化を行いたい。

>>   .Range(.Cells(GYO1, 2), .Cells(GYO2, lastcol1 - 1)).Select  
>>    Set r = Selection
>ここはSelectしないで、1行にまとめてはどうでしょうか
>Set r = .Range(.Cells(GYO1, 2), .Cells(GYO2, lastcol1 - 1))
まとめてみました。ご教示ありがとうございます。

>
>グラフの個数でなく、GYOを確認してみてはどうでしょうか。
GYOを確認するよう変更してみましたが、
ご指摘いただいた点を修正したところ、繰り返しても落ちなくなりました。
何かがよかったのでしょうか??

何度もお手を煩わせてしまいましたが、何とかなりそうです。
本当にありがとうございました!
(といいつつまたお尋ねするかもしれません;。その節はご回答いただけると幸いです。)
・ツリー全体表示

【82167】Re:ディメンションが無効
発言  マナ  - 23/6/15(木) 21:13 -

引用なし
パスワード
   ▼あおこ さん:

>当初問題なく動いていたのですが、突然
> cho.Copy のところで
>「指定したディメンションは、このグラフの種類では無効です。」
>のエラーが出るようになりました。(再実行すれば作成されますし、出ないときもあります。)

>  Set cho = sh_A3.ChartObjects(1).Duplicate.Parent 'コピー元のグラフを複製

DoEventsをこの次に移動あるいは追加してみてはどうでしょうか。


>
>それから、下記のコードでは、まれに応答なしになって落ちるため、

同じデータで、応答なしになるのでしょうか。


>ステータスバーにグラフの個数を表示させ、
>何個目のグラフで落ちるのか確認していたら、
>どうも最後のグラフが作成されるまでは行くので、
>そのあとループがうまく抜けられないのかと。。

グラフの個数でなく、GYOを確認してみてはどうでしょうか。


>コードの問題点等あればご指摘いただけませんでしょうか。

>   GYO1 = GYO ' グループの先頭行→GYO1
>   GYO = GYO + 1    ←この行は必要でしょうか?


>   .Range(.Cells(GYO1, 2), .Cells(GYO2, lastcol1 - 1)).Select  
>    Set r = Selection

ここはSelectしないで、1行にまとめてはどうでしょうか
Set r = .Range(.Cells(GYO1, 2), .Cells(GYO2, lastcol1 - 1))
・ツリー全体表示

【82166】ディメンションが無効
質問  あおこ  - 23/6/15(木) 17:56 -

引用なし
パスワード
   ▼マナ さん:
何度も申し訳ありません。
追加で質問です。

ご提示のコードを参考に下記のようにコードを書いて実行しています。

当初問題なく動いていたのですが、突然
 cho.Copy のところで
「指定したディメンションは、このグラフの種類では無効です。」
のエラーが出るようになりました。(再実行すれば作成されますし、出ないときもあります。)
解消方法がありますでしょうか。ネットで調べましたが、よく分かりませんでした。。

それから、下記のコードでは、まれに応答なしになって落ちるため、
ステータスバーにグラフの個数を表示させ、
何個目のグラフで落ちるのか確認していたら、
どうも最後のグラフが作成されるまでは行くので、
そのあとループがうまく抜けられないのかと。。

コードの問題点等あればご指摘いただけませんでしょうか。

今は
1.結果用シートを学校名で作成
2.結果用シートにクロス集計_割合シートの集計データをコピー
3.基本グラフのグラフをコピーして
4.結果用シートに貼り付け、データソースを変更
 ※質問数繰り返し
5.結果通知ひな形のデータを結果シートのグラフ上部に貼り付け、完成。
の手順で行っていますが、

うまくいかないのは、手順がよろしくないからでしょうか??
ネットや本で調べながらいろんなものを組み合わせて
見よう見まねで書いていますので、ご教示いただけるとありがたいです。

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


Sub 結果作成()

 Set wb_A = ThisWorkbook
 Set sh_A1 = wb_A.Worksheets("作業用")
 Set sh_A2 = wb_A.Worksheets("クロス集計_割合")
 Set sh_A3 = wb_A.Worksheets("基本グラフ")
 Set sh_A4 = wb_A.Worksheets("結果ひな形")
 
  gakko = sh_A1.Range("I10") & "学校"

  MsgBox "結果を作成します", vbInformation
    
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  '’学校名シートがないか確認して追加、あれば削除するコードを記述(記載省略)
  
  Set sh_A5 = wb_A.Worksheets(gakko)
  With sh_A5
   sh_A2.UsedRange.Copy
   .Activate
   .Range("A2").Select
   Selection.PasteSpecial Paste:=xlPasteAll
   Selection.PasteSpecial Paste:=xlPasteColumnWidths '<書式(列幅)もコピーします。>
   Application.CutCopyMode = False
   lastRow1 = .Range("A" & Rows.Count).End(xlUp).Row
   .Rows("2:" & lastRow1).Select 'フォント変更
   Selection.Font.Size = 10
   Selection.Font.Name = "MS Pゴシック"
   Selection.VerticalAlignment = xlCenter
   
   ' Selection.HorizontalAlignment = xlCenter
   ActiveWindow.Zoom = 80 '<アクティブシートの表示を80%にします。>
  
   .Columns("J").ColumnWidth = 2
   .Columns("T").ColumnWidth = 1
   .Rows("2:200").RowHeight = 15
      
   'ウィンドウ枠の固定
   .Range("C1").Select
   ActiveWindow.FreezePanes = True
   .Range("A1").Select
  
  ''元データ完成
  '=========================================
  ''データを基にグラフを作成
  Set cho = sh_A3.ChartObjects(1).Duplicate.Parent 'コピー元のグラフを複製
  With sh_A5.Range("A1:A20")
    cho.Height = .Height
    d = .Rows.Count + 2
  End With
  cho.Width = .Range("K1:S1").Width
  cho.Copy   ←←ここ
   
  lastRow1 = .Range("A" & Rows.Count).End(xlUp).Row
  GYO = 2 '開始行
  k = 0 'グラフの個数
  
  Do While .Cells(GYO, 1).Value <> ""
   .Activate
   Application.StatusBar = "  " & k + 1 & "個めのグラフ処理・・"
  '=========================================
  '質問ごとのデータ範囲を選択
   GYO1 = GYO ' グループの先頭行→GYO1
   GYO = GYO + 1
    ' 次の行から同じグループでない行を見つける
    Do While .Cells(GYO, 1).Value <> "合計" '条件を満たしている間処理を繰り返す
      GYO = GYO + 1
    Loop
   GYO2 = GYO  ' 同じグループの最終行→GYO2
   GYO = GYO + 1
  
   lastcol1 = .Cells(GYO1, Columns.Count).End(xlToLeft).Column '読み込み行の最終列を取得
   .Range(.Cells(GYO1, 2), .Cells(GYO2, lastcol1 - 1)).Select
    
    Set r = Selection

  '=========================================
   
   DoEvents
   DoEvents
   DoEvents
   DoEvents
   
    .Paste .Range("k17").Offset(k * d)
      
    .ChartObjects(k + 1).Chart.SetSourceData Source:=r
    .ChartObjects(k + 1).Chart.ChartTitle.Text = r(1).Value
   
   k = k + 1
   Loop
   cho.Delete
   Application.CutCopyMode = False
   Application.StatusBar = False
   
   'グラフ作成終了
   '=========================================
   G_GYO = .ChartObjects(.ChartObjects.Count).BottomRightCell.Row + 2 'グラフの右下のセルの行
  
   ''結果ひな形をコピー
   sh_A4.UsedRange.Copy
   .Activate
   .Range("K2").Select
   Selection.PasteSpecial Paste:=xlPasteAll
   'Selection.PasteSpecial Paste:=xlPasteColumnWidths '<書式(列幅)もコピーします。>
   Application.CutCopyMode = False
  
   Application.PrintCommunication = False '//プリンタとの接続を切断
   '印刷範囲設定 及び横1ページに収める
   .PageSetup.PrintArea = .Range(.Cells(1, 10), .Cells(G_GYO, 20)).Address
   .PageSetup.Zoom = False
   .PageSetup.FitToPagesWide = 1
   .PageSetup.FitToPagesTall = False
   Application.PrintCommunication = True '//プリンタと再接続
  End With 'sh_A5
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  MsgBox gakko & "分を作成しました", vbInformation

End Sub
・ツリー全体表示

【82165】Re:グラフのコピー
お礼  あおこ  - 23/6/15(木) 14:33 -

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

ご提示のコードを試したところ、快適に作成できました。
無事に目的の物が作成できそうです。
また分からなかったら質問させてください。

本当にありがとうございました。
・ツリー全体表示

【82164】Re:グラフのコピー
発言  マナ  - 23/6/14(水) 21:25 -

引用なし
パスワード
   ▼あおこ さん:

>実行時エラー1004「WorksheetクラスのPasteメソッドが失敗しました」が出る

DoEventsの回数を増やしてください

Sub test2()
  Dim cho As ChartObject
  Dim d As Double
  Dim k As Long
  Dim r As Range
  
  On Error Resume Next
  Sheet2.ChartObjects.Delete
  On Error GoTo 0
  
  Set cho = Sheet1.ChartObjects(1).Duplicate.Parent
  With Sheet2.Range("A1:A15")
    cho.Height = .Height
    d = .Rows.Count + 2
  End With
  cho.Width = Sheet2.Range("K1:S1").Width
'
  Do
    Set r = Sheet2.Range("A1:B6")
    cho.Copy
    DoEvents
    DoEvents
    DoEvents
    Sheet2.Paste Sheet2.Range("k17").Offset(k * d)

    With Sheet2.ChartObjects(k + 1).Chart
      .SetSourceData Source:=r
      .ChartTitle.Text = r(1).Value
    End With
    k = k + 1
  Loop Until k > 5
  
  cho.Delete

End Sub
・ツリー全体表示

【82163】Re:グラフのコピー
質問  あおこ  - 23/6/14(水) 18:32 -

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

何度も申し訳ありません。

さきほど「変更後、15回ほど繰り返して処理を行いましたが、今のところ大丈夫のようです。」と記載しましたが、


cho.Copy
DoEvents
.Paste .Range("k17").Offset(k * 17) ←

←の箇所で

まれに実行時エラー1004「WorksheetクラスのPasteメソッドが失敗しました」が出ることがあります。
そのまま再実行すれば貼り付けできるのですが。。

「Pasteメソッド 失敗」で検索し、「Pasteメソッドでエラーが発生する原因はクリップボードを使うからで、対策としてクリップボードを使用しないコピー方法が提示されていましたが、
Copyメソッドはグラフオブジェクトではサポートされていないとのことで、
実際
Range("A1").Copy Destination:= .Range("k17").Offset(k * 17)
を試しましたが、
実行時エラー1004「アプリケーション定義またはオブジェクト定義のエラーです」となりました。

何か良い方法がありますでしょうか。ご教示いただけると幸いです。
・ツリー全体表示

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