1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
| Sub cheq1()
Dim t1, t2, t3 As Range
Dim tt1, tt2 As Worksheet
Set tt1 = ThisWorkbook.Sheets("chab")
Set tt2 = ThisWorkbook.Sheets("four")
Set t1 = tt1.Range("b1")
tt1.Range("b4:g50") = Empty
'tt:
'x = 0
For Each c In tt2.Range("d7:d310") ' & Application.WorksheetFunction.Count(tt2.Range("d7:h310")))
'If c.Offset(0, -1).Value <> 2 And c.Offset(0, -2).Value <> "" Then
'GoTo tt
'End If
Set t2 = tt1.Range("b4:b50").Find(c.Offset(0, 5))
If c.Value = t1.Value Then
If Not t2 Is Nothing Then
t2.Offset(0, 4).Value = t2.Offset(0, 4).Value + c.Offset(0, 4)
Else
Set t3 = t1.End(xlDown).Offset(1, 0)
t1.Offset(0, 1).Value = c.Offset(0, 1).Value
t3.Offset(0, 0).Value = c.Offset(0, 5).Value
t3.Offset(0, 1).Value = c.Offset(0, 6).Value
t3.Offset(0, 2).Value = c.Offset(0, 7).Value
t3.Offset(0, 3).Value = c.Offset(0, 8).Value
t3.Offset(0, 4).Value = c.Offset(0, 4).Value
t3.Offset(0, 5).Value = c.Offset(0, -2).Value
'x = x + 1
End If
End If
Next c
End Sub
Sub test1()
Range("h2").Value = Application.WorksheetFunction.CountA(Range("d1:d310"))
Range("h222").End(xlUp).Select
End Sub |
Partager