アプリ版:「スタンプのみでお礼する」機能のリリースについて

Sheet2に1051行、28列のデータがあります。1列、3列には全部の行にデータがあります。
Sheet2のデータからIf分を使って抽出されたデータをSheet1の転記しています。
Sheet1は1,2行目に表題、発行日などがあり、3行目が項目にいなって4行目から抽出データが入るようになっています。行は1000行まであります。下記のコードを配列に書き換えるとどのようになるか教えてください。今のままで特に時間がかかるわけではないのですが、変数の意味、配列でのIf文の書き方が知りたいです。

Sub KousinMeibo()
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
wS2.Select

Dim cnt
Dim rw
Dim i, j, l, m As String
i = "前回 "
j = "札付 /"
l = "~ /"
m = "/"

wS1.Unprotect

With wS1
wS1.Range("B2").Value = wS3.Range("I15").Value
wS1.Range("K1").Value = wS3.Range("I16").Value
wS1.Range("H1").Value = Date

rw = 4
.Range("B4:N1300,P4:T1300").ClearContents
Application.EnableEvents = False
Application.ScreenUpdating = False

For cnt = 2 To 1051

If wS2.Range("W" & cnt).Value = wS3.Range("I15").Value _
Or wS2.Range("N" & cnt).Value = 1 And wS2.Range("K" & cnt).Value < Worksheets("表紙").Range("I16").Value Then
Application.StatusBar = cnt & "回目の処理をしています..."
.Range("B" & rw).Value = wS2.Range("Q" & cnt).Value + vbLf + wS2.Range("C" & cnt).Value
.Range("C" & rw).Value = wS2.Range("E" & cnt).Value + vbLf + wS2.Range("D" & cnt).Value _
+ vbLf + wS2.Range("F" & cnt).Value
.Range("D" & rw).Value = wS2.Range("J" & cnt).Value
.Range("E" & rw).Value = wS2.Range("L" & cnt).Value
.Range("F" & rw).Value = wS2.Range("W" & cnt).Value
.Range("G" & rw).Value = wS2.Range("X" & cnt).Value
.Range("H" & rw).Value = m
.Range("I" & rw).Value = i & wS2.Range("N" & cnt).Value
.Range("J" & rw).Value = wS3.Range("I16").Value
.Range("K" & rw).Value = l
.Range("M" & rw).Value = j
.Range("N" & rw).Value = wS2.Range("AB" & cnt).Value
.Range("Q" & rw).Value = wS2.Range("C" & cnt).Value
.Range("R" & rw).Value = wS2.Range("D" & cnt).Value
.Range("S" & rw).Value = wS2.Range("K" & cnt).Value
.Range("T" & rw).Value = wS2.Range("X" & cnt).Value

rw = rw + 1
End If
Next

End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Goto wS1.Range("B1")
Application.StatusBar = False
wS1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

A 回答 (2件)

こんにちは


>配列の勉強をしています
少し乱暴な回答ですみませんでした

#1で使用しているは配列の参考サイトです

エクセルの神髄 _ 鵜原パソコンソフト研究所
https://excel-ubara.com/excelvba1/EXCELVBA414.html
https://excel-ubara.com/excelvba1/EXCELVBA413.html

よねさんのWordとExcelの小部屋
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …

理解と言うよりは、実際に行い(実験)ながら覚える方が良いと思います

質問とは関係ない所なのですが・・・
Rangeオブジェクトなどとの混同を避ける為?setが無いので良いのだけれど
aryWs2 = wS2.Range("C2:AB1051") は
aryWs2 = wS2.Range("C2:AB1051").Value とするべきかも知れません
ただ、aryWs2(cnt, 21).Valueなどはダメ

Dim cnt
Dim rw

Dim i, j, l, m As String
i = "前回 "
j = "札付 /"
l = "~ /"
m = "/"

i j l はStringになりませんのでご注意を (As Variant)
また、じょうすうで決まっているのなら 
Const i As String = "前回 " のような書き方の方が良いかも知れません

Dim cnt As Long, rw As Long
配列のインデックスやRangeの行方向のカウント変数には、個人的にLong型を使っています
(もちろん今回は範囲が限定的なのでAs Integerでも範疇ですね)

あと・・
Worksheets("表紙").Range("I16").Value
wS3.Range("I15").Value
wS3.Range("I16").Value
についてもループ内で繰り返されるので
あらかじめ変数に格納してしまうのが好ましいかと・・
    • good
    • 0
この回答へのお礼

検証が遅れてしまって申し訳ありません。
何しろ配列のコードに慣れないため戸惑っています。
インデックスの間違い、1か所がありましたがあとは完璧でした。
配列なしのコードと同じ結果が得られました。
類似のプログラムが十数本ありますので、それを配列に直しながら勉強していきたいと思います。
ご指摘の箇所も変数直します。
ありがとうございました。

お礼日時:2022/09/16 12:01

こんにちは


>変数の意味、配列でのIf文の書き方が知りたいです。
具体的なものが判らないので何とも・・ 検索などで調べた方が良いかと

>下記のコードを配列に書き換えるとどのようになるか教えてください。
説明とコードが若干違うように思いますが・・コード内の実数を参考に書いて見ると・・(参考になるか分かりませんが)

With wS1
wS1.Range("B2").Value = wS3.Range("I15").Value
wS1.Range("K1").Value = wS3.Range("I16").Value
wS1.Range("H1").Value = Date

.Range("B4:N1300,P4:T1300").ClearContents
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim aryWs2, aryWs1a, aryWs1b
ReDim aryWs1a(1 To 1300, 1 To 13), aryWs1b(1 To 1300, 1 To 4)

aryWs2 = wS2.Range("C2:AB1051")

rw = 1
For cnt = LBound(aryWs2) To UBound(aryWs2)
If aryWs2(cnt, 21) = wS3.Range("I15").Value Or aryWs2(cnt, 12) = 1 And aryWs2(cnt, 9) < Worksheets("表紙").Range("I16").Value Then
Application.StatusBar = cnt & "回目の処理をしています..."

aryWs1a(rw, 1) = aryWs2(cnt, 15) + vbLf + aryWs2(cnt, 1)
aryWs1a(rw, 2) = aryWs2(cnt, 3) + vbLf + aryWs2(cnt, 2) + vbLf + aryWs2(cnt, 4)
aryWs1a(rw, 3) = aryWs2(cnt, 8)
aryWs1a(rw, 4) = aryWs2(cnt, 10)
aryWs1a(rw, 5) = aryWs2(cnt, 21)
aryWs1a(rw, 6) = aryWs2(cnt, 22)
aryWs1a(rw, 7) = m
aryWs1a(rw, 8) = i & aryWs2(cnt, 12)
aryWs1a(rw, 9) = wS3.Range("I16").Value
aryWs1a(rw, 10) = l
aryWs1a(rw, 11) = "" 'L
aryWs1a(rw, 12) = j
aryWs1a(rw, 13) = aryWs2(cnt, 26)
'Q
aryWs1b(rw, 1) = aryWs2(cnt, 1)
aryWs1b(rw, 2) = aryWs2(cnt, 2)
aryWs1b(rw, 3) = aryWs2(cnt, 9)
aryWs1b(rw, 4) = aryWs2(cnt, 22)

rw = rw + 1
End If
Next
.Range("B4").Resize(UBound(aryWs1a, 1), UBound(aryWs1a, 2)) = aryWs1a
.Range("Q4").Resize(UBound(aryWs1b, 1), UBound(aryWs1b, 2)) = aryWs1b

End With

未検証なのでインデックス間違えていたらごめんなさい
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!