質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

5204閲覧

VBA 空白をスキップしたい

mi07

総合スコア20

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/12/10 09:23

編集2019/12/10 09:25

ほぼ同じコードを使用し、うまくいく場合といかない場合があり、困り果てております。
以下のコードにおいて

Set pasteSheet = Sheets(copySheet.Cells(copyRow, "I").Value)

copyRow=3 でエラーとなり、

I列には =IF(H2=0," ",VLOOKUP(H2,商品リスト!O:P,2,0)) の数式が入っており、
H2に数値が入っており、問題なし
H3が空白の場合、エラーとなります

空白の場合のエラーをなくしたいのですが、どうしてもできません。

試したこと
* For copyRow = 2 To 7 を
For copyRow = 2 To copySheet.Cells(Rows.Count, "I").End(xlUp).Row

* If IsError(val) = False Then を
If IsNumeric(val) = True And val > 0 Then

* If IsError(val) = False Then を
If IsError(val) = False And val <> "" Then

1つずつ試しに変更してみても、うまくいきません。

どのような変更が必要でしょうが、ご教授いただけると助かります。

VBA

1Public Sub sample() 2 Sheets("データ蓄積").Select 3 最終 = Cells(Rows.Count, "A").End(xlUp).Row + 1 4 Sheets("データ移行").Select 5 6 InRow = 7 Do While Trim(Range("A" & InRow)) = "" And InRow >= 2 7 InRow = InRow - 1 8 Loop 9 If InRow <= 1 Then 10 MsgBox "データがありません。" 11 Exit Sub 12 End If 13 Range("A2:H" & InRow).Select 14 15 Selection.Copy 16 17 Sheets("データ蓄積").Select 18 Range("A" & 最終).Select 19 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 20 :=True, Transpose:=False 21 22 23 24 Dim copyRow As Long 25 Dim copySheet As Worksheet 26 Dim pasteRange As Range 27 Dim pasteSheet As Worksheet 28 Dim val As Variant 29 30 Set copySheet = Sheets("データ移行") 31 32 For copyRow = 2 To 7 33 34 val = copySheet.Cells(copyRow, "I").Value 35 36 If IsError(val) = False Then 37 **Set pasteSheet = Sheets(copySheet.Cells(copyRow, "I").Value)** 38 Set pasteRange = pasteSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1) 39 pasteRange.Resize(, 4).Value = copySheet.Range(copySheet.Cells(copyRow, 1), copySheet.Cells(copyRow, 4)).Value 40 pasteRange.Resize(, 1).Offset(, 5).Value = copySheet.Cells(copyRow, 6).Value 41 End If 42 Next 43 44 Sheets("情報入力").Select 45 Range("C6").Select 46 47End Sub 48

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

###回答

ぱっと見た感じ、以下のように書けば、できそうな気がしますが、どうでしょうか?

For copyRow = 2 To 7 val = copySheet.Cells(copyRow, "I").Value val = Replace(val, " ", "") '//全角スペースは取り除く If val <> "" Then '//空白の時はスキップ Set pasteSheet = Sheets(copySheet.Cells(copyRow, "I").Value) Set pasteRange = pasteSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1) pasteRange.Resize(, 4).Value = copySheet.Range(copySheet.Cells(copyRow, 1), copySheet.Cells(copyRow, 4)).Value pasteRange.Resize(, 1).Offset(, 5).Value = copySheet.Cells(copyRow, 6).Value End If Next

###原因推測
I列のセルに入っているIF関数でH2=0のとき全角スペースを1つ出力していると思うので、
この全角スペース1つの空白が来た時は、スキップする条件を入れる必要があると思います。
※全角スペース1つには意図があるのでしょうか?

質問者さんが試されていた以下のコードではvalの値が全角スペースのため、条件にヒットしていないと思います。
H2が0もしくは空白の場合は、I列セルのIF文ではTRUE条件(全角スペース)が選択されると思います。

If IsError(val) = False And val <> "" Then

以上、解決しましたら幸いです。

投稿2019/12/10 13:13

KazuSaka

総合スコア640

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

mi07

2019/12/13 01:19

ありがとうございます!全角スペースに気が付けませんでした。。。ありがとうございました!
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問