ＶＢＡ 条件

いつもお世話になっております。
下記のコードでおしえてくれませんでしょうか

下記のコードはCells(i, 3).Value <> ""
Ｇ1に空白でないデータを書き込むコードです。

If Cells(i, 3).Value <> "" Then　これを

If Cells(i, 3).Value　= "東京" Then

にするとエラーになります。


Dim WC() As Variant
Dim i As Long
Dim n As Long
Dim x As Long

Dim R As Range
Set R = Range("C10").CurrentRegion
With R
For i = 1 To .Rows.Count
If Cells(i, 3).Value <> "" Then
ReDim Preserve WC(n)
WC(n) = .Rows(i).Resize(, 3)
n = n + 1
End If
Next
End With

Dim wf As Object
Set wf = WorksheetFunction

Range("g1").Resize(UBound(WC), 3).Value = _
wf.Transpose(wf.Transpose(WC))

質問者からの補足コメント

• ご返事遅れて申し訳ありません
  空白を全角文字にしてるのは手打ちしたからですか？
  手打ちです
  すみませんです。

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/02/08 20:30

• ご返事遅れてすみませんです。
  Dim WC() As Variant
  Dim i As Long
  Dim n As Long
  Dim x As Long
  Dim R As Range
  Set R = Range("C8").CurrentRegion
  With R
  For i = 1 To .Rows.Count
  If Cells(i, 3).Value = "東京" Then
  ReDim Preserve WC(n)
  WC(n) = .Rows(i).Resize(, 3)
  n = n + 1
  End If
  Next
  End With
  Dim wf As Object
  Set wf = WorksheetFunction
  If Not IsEmpty(WC) Then
  Range("A1").Resize(UBound(WC) + 1, 3).Value = WC
  End If

  No.3の回答に寄せられた補足コメントです。 補足日時：2021/02/08 20:31

• 

  文字数の制限のため2回にわけました。
  上手くいきませんでした。
  申し訳ございません

    補足日時：2021/02/08 20:32

• 

  Dim i As Long, Sw()
  i = 0
  
  Dim R As Range
  For Each R In Range("C2", Cells(Rows.Count, "C").End(xlUp))
  If R.Value = "東京" Then
  ReDim Preserve Sw(i)
  Sw(i) = R.Resize(, 3).Value
  i = i + 1
  End If
  Next
  Range("G1").Value = Sw
  これもだめてすね

    補足日時：2021/02/08 20:40

• 下記のコード実行すると
  添付ファイルのように書き出されます。
  2回にわけます。
  Sub a()
  Dim i As Long, Sw()
  i = 0
  Dim R As Range
  For Each R In Range("C3", Cells(Rows.Count, "C").End(xlUp))
  If R.Value = "東京" Then
  ReDim Preserve Sw(i)
  Sw(i) = R.Resize(, 3).Value
  i = i + 1
  End If
  Next
  
  
  If Not IsEmpty(Sw) Then
  Range("g2").Resize(UBound(Sw) + 1, 3).Value = Sw(0)
  End If
  Stop
  End Sub

  No.4の回答に寄せられた補足コメントです。 補足日時：2021/02/08 22:19

• 東京 1 456
  東京 1 456
  東京 123 456
  という風になるはずなんですが、

  
    補足日時：2021/02/08 22:20

• この添付　画像ではうまくできているのですが。

  
    補足日時：2021/02/08 22:21

• 

  ReDim Preserve Sw(i, 2)で黄色反転になってしまいます。

  No.5の回答に寄せられた補足コメントです。 補足日時：2021/02/08 22:57

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2021/02/08 21:31

こんばんは、

すみません。もう一つの問題点に気が付きませんでした。
迷路に入ってしまったのは、配列にセル範囲を代入したせいですかね

下のコードサンプルで検証します。
どのような結果が望まれているのか、分かりませんが、配列にセル範囲を代入するとSwは
Sw Variant(0 to 0)
Sw(0) Variant/Variant(1 to 1, 1 to 3)
Sw(0)(1) Variant(1 to 3)
Sw(0)(1,1) Variant/String 　　値　"東京"
Sw(0)(1,2) Variant/String 　　値　"Test"
Sw(0)(1,3) Variant/String 　　値　"Test"

となります。
従って、下のコードで出力する場合は、Range("G1")の範囲をResizeして
Sw(0)を代入すれば良いと思います。
複数ある場合を想定するとSw(i)などでの出力が必要かと・・
複雑になってしまうので、ロジック自体を変えた方が良いように思います。
エラー対策の為、＃１＃３の処理を加えた方が良いと思います。

Sub a()
　 Dim i As Long, Sw()
　 i = 0
　 Dim R As Range
　 For Each R In Range("C8", Cells(Rows.Count, "C").End(xlUp))
　　 If R.Value = "東京" Then
　　　　ReDim Preserve Sw(i)
　　　　Sw(i) = R.Resize(, 3).Value
　　　　i = i + 1
　　 End If
　 Next
　 Range("G1").Resize(, 3).Value = Sw(0)
End Sub

ご自身でデバッグするヒント
変数の値や型などの変化を把握する為に　ステップ実行しながら
ローカルウインドウを活用します。
配列の構造や値が把握できますので試してみてください。

取り敢えず。

No.5 回答者： Qchan1962 回答日時： 2021/02/08 22:42

＞Range("g2").Resize(UBound(Sw) + 1, 3).Value = Sw(0)

これは、Sw(0)の値を3つに増やした範囲で出力しているだけです。
Swを再加工するとか、出力をループさせるとかになります。
Sw(0) Sw(1) Sw(2)、、しっかり説明する自信がなく、、
わかり易く良い解説サイトを少し探しましたが見つからなかったので、、
取り敢えず
少しロジックを変えた方法で（代入段階れ2次配列に入れる方法）

Dim i As Long, j As Integer
Dim Sw()
i = 0
Dim R As Range
For Each R In Range("C8", Cells(Rows.Count, "C").End(xlUp))
If R.Value = "東京" Then
ReDim Preserve Sw(i, 2)
For j = 0 To 2
Sw(i, j) = R.Offset(, j).Value
Next
i = i + 1
End If
Next
If Not IsEmpty(Sw) Then
Range("G1").Resize(, 3).Value = Sw
End If

多分　期待通りの結果になると思います。

この回答へのお礼

ありがとうございました
うまくいきました。

お礼日時：2021/02/08 23:03

No.3 回答者： Qchan1962 回答日時： 2021/02/08 11:37

＃１です。

気付きはありましたでしょうか、、他の部分も懸念されるので追記します。

配列は出力（書き出し）を考える（考えなくとも）と要素番号を0から始める事が多くあると思います。
（0から順番に代入した場合）配列に値を代入した時、要素番号0で要素数1になりますので、出力先でRange("g1").Resize(UBound(WC)+1, 3).Value =
などとして要素番号から要素数に変える
（変えているわけでないので表現は正しくないかも）必要があります。

また、空の配列に対してUBound関数を実行するとエラーが返ります。
なので、条件などで配列に値の代入がされないケースがある（想定できる）場合は、必ず（私的には）下記のように配列を調べるコードを入れます。

If Not IsEmpty(WC) Then　'配列要素があれば
Range("g1").Resize(UBound(WC) + 1, 3).Value = WC
などと書きます。
Transposeを重複させるとどうなるのかな？

No.2 回答者： めぐみん_ 回答日時： 2021/02/08 10:49

＞Cells(i, 3).Value　= "東京"

空白を全角文字にしてるのは手打ちしたからですか？

No.1 回答者： Qchan1962 回答日時： 2021/02/08 00:10

こんばんは、

If Cells(i, 3).Value　= "東京" Then　は1度だけのようですね
つまり、n=0　だと　UBound(WC)　は　0　
Resize(0, 3)　は　1004エラーですか
UBound関数は、引数に指定した配列の最も大きい『要素番号』を返します
この要素番号と言うところは、私も何度か躓きました。

この回答へのお礼

ありがとうございました
いろいろ調べてみます。

お礼日時：2021/02/08 08:08