Snasui Excel Forum

Code: Select all

Private Sub CommandButton2_Click()
Dim i As Integer
Dim j As Integer
Dim x As String
Dim y As String
Dim z As String
Dim p As String
Dim q As String
j = 2
i = 1
p = 1
q = 1

Do While j < 200
x = Sheets("TTH2").Cells(i, 1)
y = Sheets("TTH1").Cells(j, 2)
Select Case x
Case Is = y
Sheets("TTH1").Range(Cells(j, 1), Cells(j, 5)).Copy Sheets("TTH3").Cells(p, 1)
Do While p < 200
j = j + 1
p = p + 1
y = Sheets("TTH1").Cells(j, 2)
If y = "" Then
j = 200
Else
Sheets("TTH1").Range(Cells(j, 1), Cells(j, 5)).Copy Sheets("TTH3").Cells(p, 1)
q = q + 1
End If
Loop
Case Is <> y
j = j + 1
End Select
Loop
p = q + 1
End Sub

Code: Select all

Private Sub CommandButton2_Click()
Dim i As Integer
Dim j As Integer
Dim x As String
Dim y As String
Dim p As String
Dim q As String
j = 2
i = 1

Do While i < 20
Do While j < 200
x = Sheets("TTH2").Cells(i, 1)
y = Sheets("TTH1").Cells(j, 2)

Select Case x
Case Is = y
Sheets("TTH1").Range(Cells(j, 1), Cells(j, 17)).Copy Sheets("TTH2").Cells(i, 2)
j = 200
Case Is <> y
Sheets("TTH2").Cells(i, 2) = "äÁ辺¢éÍÁÙÅ"
j = j + 1
End Select
Loop
i = i + 1
j = 2
Loop

End Sub

Code: Select all

Dim rall As Range, r As Range
Dim rtAll As Range, l As Long
Dim found As Long
With Sheets("TTH1")
    Set rall = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
    With .Parent.Sheets("TTH2")
        Set rtAll = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
    End With
    For Each r In rall
        If Application.CountIf(rtAll, r) > 0 Then
            found = Application.Match(r, rtAll, 0) - 1
            With .Parent.Sheets("TTH3")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 5).Value _
                    = r.Resize(1, 5).Value
            End With
        End If
    Next r
End With