Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2013)
指定条件を増やしたい
投稿日時: 20/07/10 15:05:53
投稿者: ザックん

いつもお世話になっております。
 
以前、作成していた帳票に条件を追加したいのですが
思ったように動作できない状況です。
 
現状、T列に”280”があった場合、”280”があった行の特定の列の値を転記していますが
T列以外にF列に”加工完了”があり、ふたつの条件に合った場合、転記したいです。
ご教授願います。

投稿日時: 20/07/10 15:06:59
投稿者: ザックん

コードです。
   
 
    Dim sht1 As Worksheet, sht2 As Worksheet
        
    Dim tcell As RANGE, trow As Long, brow As Long, drow As Long
     
    Set sht1 = Sheets("sheet")
     
    Set sht2 = Sheets("出荷速報2")
     
    Set tcell = sht1.Columns("T").Find(WHAT:="110")
     Set tcell = sht1.Columns("F").Find(WHAT:="加工完了")
      
     
    If tcell Is Nothing Then
     
     
    MSGBOX "本日、完了品はありませんのでメール送信は致しません"
    End 'なかったら処理停止
 
    End If
     
 
 
    trow = tcell.Row
 
 
    
    Do
     
    brow = sht2.RANGE("b" & sht2.Rows.count).End(xlUp).Row + 1
     
    If brow < 13 Then brow = 13
     
    sht2.Cells(brow, "B").Value = sht1.Cells(tcell.Row, "I").Value
     
     
    drow = sht2.RANGE("d" & sht2.Rows.count).End(xlUp).Row + 1
        
    If drow < 13 Then drow = 13
     
    sht2.Cells(drow, "d").Value = sht1.Cells(tcell.Row, "J").Value
     
    Set tcell = sht1.Columns("F").FindNext(tcell)
     
 Loop Until tcell.Row = trow
  
 
 
 
End Sub

回答
投稿日時: 20/07/10 15:19:40
投稿者: QooApp

FIND2回かいたら1回目の定義が消えちゃうので
 
1つ目のFINDで条件A(280なら〜等)で検索
 
そのあと、
 
IF(もう1個の条件列のセル値が○○だったら)
 
両方の条件にあった場合の処理
 
ELSE
 
2つ目の条件に合わなかったとき
 
EndIF

回答
投稿日時: 20/07/10 15:36:53
投稿者: QooApp

Sub 旧配列使用タイプから改良した版()

	Dim i As Long, k As Long, array_IJ() As Long

	k = 1

	ReDim array_IJ(1, 0)

	For i = 1 To Worksheets("sheet").Cells(Rows.Count, 20).End(xlUp).Row

		If (Worksheets("sheet").Cells(i, 20).Value = 280 And Worksheets("sheet").Cells(i, 6).Value = "加工完了") Then

			ReDim Preserve array_IJ(1, k)

			array_IJ(0, k) = Worksheets("sheet").Cells(i, 9).Value

			array_IJ(1, k) = Worksheets("sheet").Cells(i, 10).Value

			k = k + 1

		End If

	Next i

	For i = 13 To 16

		Worksheets("出荷速報").Cells(i, 2).Value = array_IJ(0, k - (i - 12))

		Worksheets("出荷速報").Cells(i, 4).Value = array_IJ(1, k - (i - 12))

	Next i

End Sub

 
これじゃうごきませんか?

投稿日時: 20/07/10 16:06:46
投稿者: ザックん

  Dim sht1 As Worksheet, sht2 As Worksheet
        
    Dim tcell As RANGE, trow As Long, brow As Long, drow As Long
     
    Set sht1 = Sheets("sheet")
     
    Set sht2 = Sheets("出荷速報2")
     
    Set tcell = sht1.Columns("T").Find(WHAT:="110")
     
    If range("f")= 加工完了.then
     
     
        trow = tcell.Row
 
    Do
     
    brow = sht2.RANGE("b" & sht2.Rows.count).End(xlUp).Row + 1
     
    If brow < 13 Then brow = 13
     
    sht2.Cells(brow, "B").Value = sht1.Cells(tcell.Row, "I").Value
     
     
    drow = sht2.RANGE("d" & sht2.Rows.count).End(xlUp).Row + 1
        
    If drow < 13 Then drow = 13
     
    sht2.Cells(drow, "d").Value = sht1.Cells(tcell.Row, "J").Value
     
    Set tcell = sht1.Columns("F").FindNext(tcell)
     
 Loop Until tcell.Row = trow
    
     
    Else
     
    MSGBOX "本日、研磨完了品はありませんのでメール送信は致しません"
    End 'なかったら処理停止
 
    End If
     
 
 
End Sub
 

投稿日時: 20/07/10 16:08:12
投稿者: ザックん

お世話になっております。
QooApp様
 
いつもありがとうございます。
 
if文でエラーしてしまいました。
 
ご教授願います。

投稿日時: 20/07/10 16:26:38
投稿者: ザックん

 お世話になっております。
 
すみません。
下記で止まってしまいます。
 
array_IJ(0, k) = Worksheets("sheet").Cells(i, 9).Value
 
k1とでます。

回答
投稿日時: 20/07/10 17:48:26
投稿者: QooApp

    For i = 13 To 16
        
        If (i - 13 > UBound(array_IJ)) Then
            Worksheets("出荷速報").Cells(i, 2).Value = 0
            Worksheets("出荷速報").Cells(i, 4).Value = 0 '無いよってときは0でいいのかな?
        Else
            Worksheets("出荷速報").Cells(i, 2).Value = array_IJ(0, k - (i - 12))
            Worksheets("出荷速報").Cells(i, 4).Value = array_IJ(1, k - (i - 12))
        End If
    Next i

 
こっちから送信したデータの下段のfor文を上記に書き換えてみてください。

投稿日時: 20/07/11 11:09:44
投稿者: ザックん

お世話になっております。
試してみました。
 
    For i = 13 To 16
         
        If (i - 13 > UBound(array_IJ)) Then
            Worksheets("出荷速報").Cells(i, 2).Value = 0
            Worksheets("出荷速報").Cells(i, 4).Value = 0 '無いよってときは0でいいのかな?
 
無いときは、空白にしたいので=""でいいのでしょうか。
 
        Else
            Worksheets("出荷速報").Cells(i, 2).Value = array_IJ(0, k - (i - 12))
            Worksheets("出荷速報").Cells(i, 4).Value = array_IJ(1, k - (i - 12))
        End If
    Next i
 
 
⇒ Worksheets("出荷速報").Cells(i, 2).Value = array_IJ(0, k - (i - 12))
 
ここでエラーしてしまいます。
 
 

回答
投稿日時: 20/07/11 17:57:28
投稿者: QooApp

エラーがインデックス範囲外なら
多分マイナス12じゃなくて13かも。
 
というかこっちでは正常に動くんだけどなあ。

回答
投稿日時: 20/07/12 09:04:53
投稿者: simple

横入り失礼。

引用:
現状、T列に”280”があった場合、”280”があった行の特定の列の値を転記していますが
T列以外にF列に”加工完了”があり、ふたつの条件に合った場合、転記したいです。
とのこと。
前回の話はT列だけだったようで、今回、F列の要素を考えたい、ということですね?
 
コード案を見ると、T列とF列を別々にFind(ないしFindNext)しているようですが、
110がT列にあった場合、その行のF列を見るんでしょう?
だったら、F列を検索する必要は無いですよね。
 
既に指摘があるように、Findは使わずに、
一行ごとに、T列とF列を見て判定する方法のほうが間違いがないですよ。
Findの繰り返し処理とかは、結構注意が必要ですから。
仮に使うにしても、T列でヒットしたら、その行のF列を使うようにすればよいでしょう。
 
参考までにコード例をあげておきます。
Sub test3()
    Dim sht1 As Worksheet, sht2 As Worksheet
    Dim brow As Long
    Dim k As Long

    Set sht1 = Sheets("sheet")
    Set sht2 = Sheets("出荷速報")

    For k = 1 To sht1.Cells(Rows.Count, "A").End(xlUp).Row
        If sht1.Cells(k, "T").Value = 110 Then
            If sht1.Cells(k, "F").Value = "加工完了" Then
                'sht2に転記
                brow = sht2.Range("B" & sht2.Rows.Count).End(xlUp).Row + 1
                If brow < 13 Then brow = 13
                sht2.Cells(brow, "B").Value = sht1.Cells(k, "I").Value
                sht2.Cells(brow, "D").Value = sht1.Cells(k, "J").Value
            End If
        End If
    Next
End Sub
( 実働検証していないので、そちらで確認お願いします。 )
 
# なお、インデントをもう少し正確につけたほうがよいのと、
# 余り不要な行間隔を空けないほうがよいと思います。
# 1行おきにすると見やすくなるというものでもないし、却って意味あるかたまりが崩れて、
# コードが読みにくいです。

投稿日時: 20/07/12 15:24:55
投稿者: ザックん

QooApp様
simple様
お世話になっております。
ありがとうございます。何とか動作することが出来ました!