Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


37487 / 76738 ←次へ | 前へ→

【44416】Re:シートの比較、ご教授下さい。(再再記載)
発言  ichinose  - 06/11/15(水) 19:55 -

引用なし
パスワード
   こんばんは。

文字列だとそうなりますね!!
これは、明らかにバグです。


>Sub 実行()
>  Dim sh1rng As Range
>  Dim sh2rng As Range
>  Dim addA As String
>  Dim addB As String
>  Dim sh2strw As Long
>  Dim idx As Long, jdx As Long
>  Dim rw As Variant
>  Dim nsign As String
>  '↓本文
>  With Worksheets("sheet1")
>    Set sh1rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
>    End With
>  If sh1rng.Row > 1 Then
>    With Worksheets("sheet2")
>     Set sh2rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
>     sh2strw = sh2rng.Row
>     If sh2strw > 1 Then
>       addA = sh2rng.Address(, , , True)
>       addB = sh2rng.Offset(0, 1).Address(, , , True)
>       End If
>     End With
>    For idx = 1 To sh1rng.Count
>     rw = CVErr(xlErrNA)
>     If sh2strw > 1 Then
       rw = Evaluate("=match(1,(" & addA & "=" & _
           sh1rng.Cells(idx).Address(, , , True) & _
           ")*(" & addB & "=" & _
           sh1rng.Offset(0, 1).Cells(idx).Address(, , , True) & _
           "),0)")
       '↑検索 このように訂正してください
>       End If
>     With Worksheets("sheet3")
>       .Cells(idx * 2, 1).Value = 1
>       .Range(.Cells(idx * 2, 2), .Cells(idx * 2, 12)).Value = sh1rng(idx).Resize(, 11).Value
>       .Cells(idx * 2 + 1, 1).Value = 2
>       If IsError(rw) Then
>        Select Case sh1rng(idx, 3).Value
>         Case "D":
>            nsign = "-"
>         Case Else:
>            nsign = "*"
>            .Range(.Cells(idx * 2 + 1, 2), .Cells(idx * 2 + 1, 3)).Interior.ColorIndex = 3
>        End Select
>        .Range(.Cells(idx * 2 + 1, 2), .Cells(idx * 2 + 1, 3)).Value = nsign
>       Else
>        .Range(.Cells(idx * 2 + 1, 2), .Cells(idx * 2 + 1, 12)).Value = sh2rng(rw).Resize(, 11).Value
>        Select Case sh1rng(idx, 3).Value
>          Case "A", "U":
>            For jdx = 5 To 12
>             If .Cells(idx * 2, jdx).Value <> .Cells(idx * 2 + 1, jdx).Value Then
>               .Cells(idx * 2 + 1, jdx).Interior.ColorIndex = 3
>               End If
>             Next jdx
>         Case Else:
>          .Range(.Cells(idx * 2 + 1, 2), .Cells(idx * 2 + 1, 3)).Interior.ColorIndex = 3
>        End Select
>       End If
>       End With
>     Next
>    End If
>End Sub
>-------------------------------
>以上です。
>それでは失礼致します。
0 hits

【44413】シートの比較、ご教授下さい。(再再記載) ドルフィン 06/11/15(水) 18:46 質問
【44416】Re:シートの比較、ご教授下さい。(再再記... ichinose 06/11/15(水) 19:55 発言
【44417】Re:シートの比較、ご教授下さい。(再再記... ドルフィン 06/11/15(水) 20:10 お礼

37487 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free