Excel VBA質問箱 IV

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

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


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

3 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【82432】Re:エクセルシートを増やすと VBA の速...

マナ - 25/1/24(金) 8:19 -


	引用なし

	パスワード

▼westwindow さん：

>1分かかる処理があるとして

どんな処理ですか。コードを提示できませんか。

・ツリー全体表示


	【82431】複数の指定された項目を転記したい

初心者です。 - 25/1/24(金) 0:31 -


	引用なし

	パスワード

はじめまして。

Aのシートにあるデータから、複数の指定した『項目の列』を
2行目からデータラストまで、Bのシートに転記したいのですが、
調べたり、試行錯誤しても列ごと(項目含め)転記しか
成功しません。

Aシート(元データ)
1行目(A列～AA列):項目　　 ⇽　名前、電話、住所、県、市　など項目があります。
2行目以降は項目ごとのデータがある

Bシート(抽出先)
1行目(A列～Z列):項目　⇽　住所、県、電話、県　　
2行目以降に、該当する項目のデータを貼り付けたい

2週間ほど、検索をしたり、参考書読んだり、YouTubeみたり
したのですが分からず、仕事も効率よくやりたいのですが進まず困っていました。

どなたなわかる方いらっしゃいましたら、教えていただけないでしょうか。
よろしくお願いします。

・ツリー全体表示


	【82430】エクセルシートを増やすと VBA の速度が...

westwindow - 25/1/23(木) 15:16 -


	引用なし

	パスワード

エクセルで VBAを使用したシートをコピーして増やすとコピーしたシート分だけ実行時間がかかります。1分かかる処理があるとしてシート 1つ増やすと2分かかります。シートを2つ増やすと３分かかります。なぜこのようなことが起こるのかわからないのですが、大変困っています。防ぐ方法がある場合教えていただけないでしょうか。

環境
Windows 10
エクセル2016

・ツリー全体表示


	【82429】Re:サンダーバードの添付ファイルを複数個

マナ - 25/1/20(月) 21:21 -


	引用なし

	パスワード

▼ぽぽぽんさん：

検索してみました。
ht tps://gohomeasap.com/thunderbird-11/

・ツリー全体表示


	【82428】サンダーバードの添付ファイルを複数個

ぽぽぽん - 25/1/20(月) 16:34 -


	引用なし

	パスワード

お世話になります。

サンダーバードのメール添付で複数ファイルを指定したいのですが
上手くいきません。
下記のコードですと、attachPath1は反映されるのですが
attachPath2が添付されません。
問題個所は「'資料」以降かと思います。

どなたかお分かりになりましたらよろしくお願いします。
(補足　attachPath1が空欄のときでもattachPath2は反映されませんでした。
サンダーバードで自動化されている方のを参考にして、attachPath1とattachPath2
を始まりと終わりをシングルコーテションで囲んでもみたんですが
上手くいきませんでした)

-----------------------------------------------------------
Sub メール送付()

Set masta = Worksheets("取引先マスタ")
Set taisyou = Worksheets("今回メール送付対象顧客")

'メールの作成

Dim sPath As String
Dim mailTo, cc1, cc2, to2, to3 As String
Dim subject, attachPath1, attachPath2, seikyusyo, attachPath As String
Dim mailBody1, mailBody2, atesaki As String

Dim 正式名称, 担当者名
正式名称 = "D"
担当者名 = "G"

'サンダーバード呼び出し
sPath = """C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"" -compose "

With taisyou
Dim lastr, i
lastr = .Cells(Rows.Count, "F").End(xlUp).Row

For i = 2 To lastr

'メール本体
mailTo = .Cells(i, "H").Value
to2 = .Cells(i, "I").Value
to3 = .Cells(i, "J").Value
cc1 = .Cells(i, "K").Value
cc2 = .Cells(i, "L").Value

subject = Worksheets("メール共通").Range("B1").Value
atesaki = .Cells(i, 正式名称) & vbLf & .Cells(i, 担当者名) & vbLf
mailBody1 = Worksheets("メール共通").Range("B2").Value

'請求書

'資料

attachPath1 = Worksheets("添付物").Range("B2").Value
attachPath2 = Worksheets("添付物").Range("B3").Value

Shell sPath & "to=" & mailTo & ";" & to2 & ";" & to3 & _
",cc=" & cc1 & ";" & cc2 & _
",subject=" & subject & ",body=" & atesaki & vbLf & mailBody1 & _
vbLf & ",attachment=" & attachPath1 & "," & attachPath2

Next
End With

End Sub

・ツリー全体表示


	【82427】Re:CurrentRegionについて

マナ - 24/12/27(金) 21:12 -


	引用なし

	パスワード

▼櫛田さん：

> For i = 3 To Range("C3").CurrentRegion.Rows.Count

CurrentRegion.Rows.Countだと、行数になりますが？
iは最終セルの行番号まで繰り返すべき。

Sub test()
　　Dim i As Long, j As Long
　　
　　For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
　　　　For j = 3 To Cells(2, Columns.Count).End(xlToLeft).Column
　　　　　 Cells(i, j).FormulaR1C1 = "=R2C*RC2"
　　　　Next
　　Next

End Sub

------------
行数で繰り返すなら

Sub test2()
　　Dim r As Range
　　Dim i As Long, j As Long
　　
　　Set r = Range("C3").CurrentRegion
　　For i = 2 To r.Rows.Count
　　　　For j = 2 To r.Columns.Count
　　　　　　r(i, j).FormulaR1C1 _
　　　　　　　　= "=R" & r.Row & "C*RC" & r.Column
　　　　Next
　　Next

End Sub

------------
なお繰り返しは不要で、一括で数式を挿入できます。

Sub test3()
　　Dim r As Range
　　
　　Set r = Range("C3").CurrentRegion
　　Intersect(r, r.Offset(1, 1)).FormulaR1C1 _
　　　　= "=R" & r.Row & "C*RC" & r.Column

End Sub

・ツリー全体表示


	【82426】Re:CurrentRegionについて

ふぇふぇ - 24/12/27(金) 19:49 -


	引用なし

	パスワード

Range("C3").CurrentRegion.select
ってやってみればわかるんじゃないですか

・ツリー全体表示


	【82425】CurrentRegionについて

櫛田 - 24/12/27(金) 14:28 -


	引用なし

	パスワード

C3からL12に解答を記載する100マス計算の問題です。
B2が空白、B3～B12に1～10、C2～L2に1～10が記載されています。

for i = 3 to 12
for j = 3 to 12
Cells(i, j).FormulaR1C1 = "=R2C*RC2"

とするとうまくいくのですが、

For i = 3 To Range("C3").CurrentRegion.Rows.Count
For j = 3 To Range("C3").CurrentRegion.Columns.Count
Cells(i, j).FormulaR1C1 = "=R2C*RC2"

とすると、9×9までしか計算されず、10の段が計算されません。
勉強をはじめたばかりでなぜかわからず。。。
どならかどうぞご回答よろしくお願いいたします。

・ツリー全体表示


	【82424】Re:同じ様式のシートの箇所をsheet1にコ...

西森 - 24/12/24(火) 1:57 -


	引用なし

	パスワード

▼マナさん：
できました。
心より感謝致します。
ありがとうございました❢

・ツリー全体表示


	【82423】Re:同じ様式のシートの箇所をsheet1にコ...

マナ - 24/12/21(土) 8:34 -


	引用なし

	パスワード

▼西森さん：

>コピーした結果が057と表示されるようにするにはどうすればいいでしょうか。

貼り付け先（A列）の書式を、「文字列」に設定しておくとよいです。

・ツリー全体表示


	【82422】Re:同じ様式のシートの箇所をsheet1にコ...

西森 - 24/12/20(金) 23:56 -


	引用なし

	パスワード

▼マナさん：

セルには数値が文字列として保存されています。
例： 057
このVALUEをコピーすると
57 になってしまいます。
コピーした結果が057と表示されるようにするにはどうすればいいでしょうか。

・ツリー全体表示


	【82421】Re:同じ様式のシートの箇所をsheet1にコ...

マナ - 24/12/20(金) 8:45 -


	引用なし

	パスワード

▼西森さん：

Sub test()
　　Dim wsCons As Worksheet
　　Dim ws As Worksheet
　　Dim n As Long
　　
　　Set wsCons = ThisWorkbook.Worksheets("Sheet1")
　　n = 2
　　For Each ws In ThisWorkbook.Worksheets
　　　　If ws.Name Like "別紙３*" Then
　　　　　　wsCons.Cells(n, "A").Value = ws.Cells(22, "B").Value
　　　　　　n = n + 1
　　　　End If
　　Next
　　
End Sub

・ツリー全体表示


	【82420】同じ様式のシートの箇所をsheet1にコピし...

西森 - 24/12/20(金) 0:34 -


	引用なし

	パスワード

こんにちは。
xslmの中に同じ様式のシートがたくさんあります。[シート名は　別紙３、別紙３ (2)、別紙３ (3)、別紙３ (4)、別紙３ (n)、、、、となっています。]

その特定セル（結合されてる）たちを、同じbookのsheet1に次々と値をコピーしたいです。
教えてほしいのはどうnをループさせるか、と、別紙３の値をコピーし終えたら　別紙３ (2)の値をsheet1の１つ下の行にコピーするのをどうやるか　です。

よろしくお願いします。

～～

Sub Macro3()
'
' Macro1 Macro
'

　　Sheets("別紙３ (2)").Select
　　Range("B22:K22").Select
　　Selection.UnMerge
　　Range("B22").Select
　　Application.CutCopyMode = False
　 ' ActiveCell.FormulaR1C1 = ""
　　Selection.Copy
　　Sheets("Sheet1").Select
　　Range("A2").Select
　　'ActiveSheet.Paste
　　
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

　　Sheets("別紙３ (2)").Select
　　Range("B22:K22").Select
　　Selection.Merge
　　
　　
　　Sheets("別紙３ (2)").Select
　　Range("B20:Q20").Select
　　Selection.UnMerge
　　Range("B20").Select
　　Application.CutCopyMode = False
　　' ActiveCell.FormulaR1C1 = ""
　　Selection.Copy
　　Sheets("Sheet1").Select
　　Range("B2").Select
　 ' ActiveSheet.Paste
　　
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　　　
　　Sheets("別紙３ (2)").Select
　　Range("B20:Q20").Select
　　Selection.Merge
　　
　　
　　ActiveWindow.ScrollColumn = 2
　　ActiveWindow.ScrollColumn = 1
End Sub

・ツリー全体表示


	【82419】Re:sumifsを使ったVBAの作り方

NANAMI

- 24/12/18(水) 17:27 -


	引用なし

	パスワード

▼マナさん：
>▼NANAMI さん：
>>
>>for nextとsumifsを使って作りたいのです
>
>Worksheets("練習15")では、ループ必要ないでしょう。
>
>Sub test()
>　　Dim r1 As Range
>　　Dim r2 As Range
>　　Dim i As Long
>　　Dim j As Long
>　　
>　　Set r1 = Worksheets("練習15").Range("A1").CurrentRegion
>　　Set r2 = Worksheets("練習15_回答").Range("A1").CurrentRegion
>　　
>　　For i = 2 To r2.Rows.Count
>　　　　For j = 2 To r2.Columns.Count
>　　　　　　r2(i, j).Value = WorksheetFunction.SumIfs(r1.Columns(3), _
>　　　　　　　　r1.Columns(1), r2(1, j).Value, r1.Columns(2), r2(i, 1).Value)
>　　　　Next
>　　Next
>
>End Sub
>
>数式を一括で挿入して、それを値に変換すると
>ープなしでできます。
>
>Sub test2()
>　　Dim r1 As Range
>　　Dim r2 As Range
>　　Dim f As String
>
>　　Set r1 = Worksheets("練習15").Range("A1").CurrentRegion
>　　Set r2 = Worksheets("練習15_回答").Range("A1").CurrentRegion
>　　Set r2 = Intersect(r2, r2.Offset(1, 1))
>　　
>　　f = "=sumifs(" _
>　　　　& r1.Columns(3).Address(-1, -1, , -1) & "," _
>　　　　& r1.Columns(1).Address(-1, -1, , -1) & "," _
>　　　　& r2(0, 1).Address(-1, 0) & "," _
>　　　　& r1.Columns(2).Address(-1, -1, , -1) & "," _
>　　　　& r2(1, 0).Address(0, -1) & ")"
>　　　　
>　　r2.Formula = f
>　　r2.Value = r2.Value
>
>End Sub

sumifsを使ったVBA、とてもわかりやすかったです。理解できました。ありがとうございました。

・ツリー全体表示


	【82418】Re:sumifsを使ったVBAの作り方

マナ - 24/12/17(火) 20:09 -


	引用なし

	パスワード

▼NANAMI さん：
>
>for nextとsumifsを使って作りたいのです

Worksheets("練習15")では、ループ必要ないでしょう。

Sub test()
　　Dim r1 As Range
　　Dim r2 As Range
　　Dim i As Long
　　Dim j As Long
　　
　　Set r1 = Worksheets("練習15").Range("A1").CurrentRegion
　　Set r2 = Worksheets("練習15_回答").Range("A1").CurrentRegion
　　
　　For i = 2 To r2.Rows.Count
　　　　For j = 2 To r2.Columns.Count
　　　　　　r2(i, j).Value = WorksheetFunction.SumIfs(r1.Columns(3), _
　　　　　　　　r1.Columns(1), r2(1, j).Value, r1.Columns(2), r2(i, 1).Value)
　　　　Next
　　Next

End Sub

数式を一括で挿入して、それを値に変換すると
ープなしでできます。

Sub test2()
　　Dim r1 As Range
　　Dim r2 As Range
　　Dim f As String

　　Set r1 = Worksheets("練習15").Range("A1").CurrentRegion
　　Set r2 = Worksheets("練習15_回答").Range("A1").CurrentRegion
　　Set r2 = Intersect(r2, r2.Offset(1, 1))
　　
　　f = "=sumifs(" _
　　　　& r1.Columns(3).Address(-1, -1, , -1) & "," _
　　　　& r1.Columns(1).Address(-1, -1, , -1) & "," _
　　　　& r2(0, 1).Address(-1, 0) & "," _
　　　　& r1.Columns(2).Address(-1, -1, , -1) & "," _
　　　　& r2(1, 0).Address(0, -1) & ")"
　　　　
　　r2.Formula = f
　　r2.Value = r2.Value

End Sub

・ツリー全体表示


	【82417】sumifsを使ったVBAの作り方

NANAMI

- 24/12/17(火) 13:12 -


	引用なし

	パスワード

VBAを勉強し始めたばかりの初心者です。
sheet1の売り上げデータを元に、sheet2（sheet2とはタブが別のシート）の店と商品ごとの売り上げ集計をしたい。といった問題です。
模範解答はこちらです。
Sub 練習問題15()
　　Dim i As Long
　　Dim ixR As Long
　　Dim ixC As Long
　　Dim ws1 As Worksheet
　　Dim ws2 As Worksheet
　　Set ws1 = Worksheets("練習15")
　　Set ws2 = Worksheets("練習15_回答")
　　ws2.Range("A1").CurrentRegion.Offset(1, 1).ClearContents
　　With ws1
　　　　For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
　　　　　　ixC = 2
　　　　　　Do Until ws2.Cells(1, ixC) = .Cells(i, 1)
　　　　　　　　ixC = ixC + 1
　　　　　　Loop
　　　　　　ixR = 2
　　　　　　Do Until ws2.Cells(ixR, 1) = .Cells(i, 2)
　　　　　　　　ixR = ixR + 1
　　　　　　Loop
　　　　　　ws2.Cells(ixR, ixC) = ws2.Cells(ixR, ixC) + .Cells(i, 3)
　　　　Next
　　End With
End Sub

do loop　の無限ループを防ぎたく、for nextとsumifsを使って作りたいのですが、作り方がわかりません。
どなたかご教示いただきたくお願いいたします。
ちなみにこちらがsumifsで自分なりに作ったVBAです。当然起動しませんでした。

Sub 練習問題15()
　　Application.ScreenUpdating = False
　　Dim i As Long
　　Dim j As Long
　　Dim ws2Row As Long
　　Dim ws2column As Long
　　Dim ws1 As Worksheet
　　Dim ws2 As Worksheet
　　Set ws1 = Worksheets("練習15")
　　Set ws2 = Worksheets("練習15_回答")
　　ws2.Range("A1").CurrentRegion.Offset(1, 1).ClearContents
　　With ws1
　　　　For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　　　　For j = 1 To 3
　　　　　　With ws2
　　　　　　For ws2Row = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　　　　　　For ws2column = 2 To 5
　　　　　　.Cells(ws2Row, ws2column).Value = Application.WorksheetFunction.
　　　　　　　　SumIfs(.Range("C1", Cells(i, 3)), .Range("A1", Cells(i, 1)), Cells(1, ws2column), .Range("B1", Cells(i, 2)), Cells(ws2Row, 1))
　　　　　　Next
　　　　　　End With
　　End With
　　　　
End Sub

・ツリー全体表示


	【82416】Re:範囲内のセルをダブルクリックでカウ...

ｍｍｍｍ

- 24/12/9(月) 17:15 -


	引用なし

	パスワード

▼マナさん：

解決しました！
ご協力ありがとうございます！
勉強になりました！！

・ツリー全体表示


	【82415】Re:weekdayを使用した合計金額と曜日ごと...

NANAMI

- 24/12/9(月) 16:56 -


	引用なし

	パスワード

▼マナさん：
>▼NANAMI さん：
>
>1)
>
>>intW = Weekday(DateSerial(Cells(i, 1), Cells(i, 2), Cells(i, 3)), vbMonday)
>
>intW は、月曜日なら1、火曜日なら2、…、日曜日なら7
>
>
>したがって、
>
>>「Cells(intW + 1, ●)」
>
>月曜日なら2行目、火曜日なら3行目、…、日曜日なら8行目に
>集計結果を出すということ。
>
>
>2)
>
>>Cells(intW + 1, 7) = Cells(intW + 1, 7) + Cells(i, 4)
>
>7列目（行は曜日別）に、4列目の値（売上金額）を加算
>
>>Cells(intW + 1, 8) = Cells(intW + 1, 8) + 1
>
>8列目（行は曜日別）に、1を加算
>
>
>これすべてのデータで繰り返すことで、
>売上の合計と日数を曜日別に行を変えて出力しています。
>
>
>　　　

問題の出題元よりもわかりやすい解説を提示いただきありがとうございました。
大変助かりました。ありがとうございました。

・ツリー全体表示


	【82414】Re:weekdayを使用した合計金額と曜日ごと...

マナ - 24/12/8(日) 9:21 -


	引用なし

	パスワード

▼NANAMI さん：

1)

>intW = Weekday(DateSerial(Cells(i, 1), Cells(i, 2), Cells(i, 3)), vbMonday)

intW は、月曜日なら1、火曜日なら2、…、日曜日なら7

したがって、

>「Cells(intW + 1, ●)」

月曜日なら2行目、火曜日なら3行目、…、日曜日なら8行目に
集計結果を出すということ。

2)

>Cells(intW + 1, 7) = Cells(intW + 1, 7) + Cells(i, 4)

7列目（行は曜日別）に、4列目の値（売上金額）を加算

>Cells(intW + 1, 8) = Cells(intW + 1, 8) + 1

8列目（行は曜日別）に、1を加算

これすべてのデータで繰り返すことで、
売上の合計と日数を曜日別に行を変えて出力しています。

　　　

・ツリー全体表示


	【82413】weekdayを使用した合計金額と曜日ごとの...

NANAMI

- 24/12/7(土) 23:43 -


	引用なし

	パスワード

A列とB列、C列にそれぞれ、年月日が分けて入力されており、日にちごとに売上金額が記載されている表です。それを、曜日ごとに売上金額の合計と日数、曜日ごとの売り上げ平均を別の表にまとめようとしています。

Sub 練習問題12()
　　Dim i As Long
　　Dim intW As Integer
　　Range("G2:I8").ClearContents
　　For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
　　　　intW = Weekday(DateSerial(Cells(i, 1), Cells(i, 2), Cells(i, 3)), vbMonday)
　　　　Cells(intW + 1, 7) = Cells(intW + 1, 7) + Cells(i, 4)
　　　　Cells(intW + 1, 8) = Cells(intW + 1, 8) + 1
　　Next
　　For i = 1 To 7
　　　　Cells(i + 1, 9) = Cells(i + 1, 7) / Cells(i + 1, 8)
　　Next
End Sub

上記答えの、
　　　　Cells(intW + 1, 7) = Cells(intW + 1, 7) + Cells(i, 4)
　　　　Cells(intW + 1, 8) = Cells(intW + 1, 8) + 1
　　Next
　　For i = 1 To 7
　　　　Cells(i + 1, 9) = Cells(i + 1, 7) / Cells(i + 1, 8)
の部分がすべてわからないのですが、特に、「Cells(intW + 1, ●)」はどういう意味でしょうか？
なにを示しているのでしょうか？

VBAを我流で勉強し始めて一週間程度です。
ご回答いただけると幸いです。

・ツリー全体表示


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

3 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free