Excel （VBA） |
 
|
(Windows 10 Pro : Excel 2016)
複数条件の内容が一致したら、セルの数字を書き換える
投稿日時: 23/08/05 22:01:17
投稿者: SHIBARAKU
|
|---|---|
|
シート1にキーとなる項目(場所・日付・番号)と変更したい番号を入力します。
|
|
|
投稿日時: 23/08/06 12:06:24
投稿者: simple
|
|---|---|
|
気づいたことをメモします。
ElseIf ino_cnt = 2 Thenこの ino_cnt とは何でしょうか。投稿時のミスでしょうか。 実行されているコードをそのままコピーペイストすると間違いを防げます。 実行されているコードがそうなっているのでしょうか。 コードの最初に Option Explicit を入れると、未宣言の変数には警告が出て、こうしたミスを防げます。 また、変数はすべてをVariant ですまさず、できるだけ内容に沿ったものにしたほうが よいでしょう。 (2) '検索用_場所コードセット
basho_c = ws1.Range("A" & cellno).Value
'検索用_日付セット
day_1 = ws1.Range("B" & cellno).Value
'検索用_番号セット
no_1 = ws1.Range("C" & cellno).Value
は、cell_noが12～16ですが、それは説明された表と違いますよね。 整合性がとれたものにしてください。 (3) For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'シート２の2～最終行までループ
cells_cnt = 2
If basho_c = Cells(cells_cnt, 1) And _
day_1 = Cells(cells_cnt, 2) And _
no_1 = Cells(cells_cnt, 3) Then '場所、日付、番号の条件が揃ったら変更
Cells(cells_cnt, 3) = no_2
cells_cnt = cells_cnt + 1
End If
Next
繰り返し変数j が中で使われていないので、各行を見に行っていません。 何か勘違いがあるのでは？ (4)色々なところに、Workbooks("テスト.xlsm").Sheets("シート１")といったものが 出てきますが、変数にすると、もっと見やすくなるのではないですか？ (5)デバッグ方法はご存じですか？ステップ実行とか、ローカルウインドウの利用方法とか。 一発で動作するコードを書けることは稀ですので、デバッグ方法の理解は必須です。 ご自分でデバッグするのも必要な学習かと思います。 |
|
|
|
投稿日時: 23/08/06 12:18:19
投稿者: simple
|
|---|---|
|
こんな風に書くと良いと思います。
Sub 変更貼り付け_改案()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim basho As String
'Dim day_1 As Date
Dim day_1 As String
Dim no_1 As String
Dim no_2 As String
Dim j As Long
Set ws1 = ThisWorkbook.Sheets("シート１")
Set ws2 = ThisWorkbook.Sheets("シート２")
For Each rng In ws1.Range("A2:A6")
basho = rng.Value 'A列 検索用_場所コード
day_1 = rng.Offset(, 1).Value 'B列 検索用_日付
no_1 = rng.Offset(, 2).Value 'C列 検索用_番号
no_2 = rng.Offset(, 4).Value 'E列 変更後番号
With ws2
For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If basho = .Cells(j, "A") Then
If day_1 = .Cells(j, "B") Then
If no_1 = .Cells(j, "C") Then
.Cells(j, "C") = no_2
'' .Cells(j, "D") = 1
End If
End If
End If
Next
End With
Next
End Sub
【備考】 If basho = .Cells(j, "A") And _
day_1 = .Cells(j, "B") And _
no_1 = .Cells(j, "C") Thenと書いても同じ結果は得られますが、
こう書くと、basho が Cells(j, "A")と不一致でも、 day_1 = .Cells(j, "B") や no_1 = .Cells(j, "C") を 評価してしまうので、無駄です。 上記のコードのようにIFを重ねたほうが実行効率は良くなります。 |
|
|
|
投稿日時: 23/08/06 16:44:07
投稿者: WinArrow
|
|---|---|
|
シート２側のループをなくしたサンプルコードを紹介します。
Sub 別案サンプル()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim RX1 As Long
Dim CNT As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("sheet2")
With ws1
For RX1 = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIfs( _
ws2.Columns("A"), .Cells(RX1, "B"), _
ws2.Columns("B"), .Cells(RX1, "C"), _
ws2.Columns("C"), .Cells(RX1, "D")) = 1 Then _
Call WS2UPDaTE(ws2:=ws2, _
key1:=.Cells(RX1, "B"), _
key2:=.Cells(RX1, "C"), _
key3:=.Cells(RX1, "D"), _
DATA:=.Cells(RX1, "E"))
End If
Next
End With
End Sub
Private Sub WS2UPDaTE(ws2, key1, key2, key3, DATA)
Dim MYCELL As Range
With ws2
With .Range("A1")
.AutoFilter
.AutoFilter field:=1, Criteria1:=key1
.AutoFilter field:=2, Criteria1:=key2
.AutoFilter field:=3, Criteria1:=key3
For Each MYCELL In .CurrentRegion.SpecialCells(xlCellTypeVisible)
If MYCELL.Column = 3 Then
MYCELL.Value = DATA
End If
Next
.AutoFilter
End With
End With
End Sub
|
|
|
投稿日時: 23/08/07 14:06:41
投稿者: SHIBARAKU
|
|---|---|
|
simpleさん
|
|
