mcngoht 2010. júl. 11. 09:11 | válasz | #1041
Ezzel a makróval milehet a baj? Csak egy-két dolgot írtam át rajta, de azok csak az oszlopok elhelyezését módosította, szerintem. Csak a 6. sorokba ír, és nem megy tovább.. Sub szortiroz() Dim a As Variant, oszlop As Integer, usor As Integer Dim k As Integer, sz As String a = Left(Cells(1), 5) Select Case a Case 10000 oszlop = 11: k = 5: GoTo Szort Case 20000 oszlop = 12: k = 5: GoTo Szort Case 30000 oszlop = 15: k = 5: GoTo Szort Case 40000 oszlop = 20: k = 5: GoTo Szort Case 50000 oszlop = 25: k = 5: GoTo Szort End Select a = Left(Cells(1), 4) Select Case a Case 1000 oszlop = 8: k = 4: GoTo Szort Case 2000 oszlop = 9: k = 4: GoTo Szort Case 3000 oszlop = 14: k = 4: GoTo Szort Case 4000 oszlop = 19: k = 4: GoTo Szort Case 5000 oszlop = 10: k = 4: GoTo Szort End Select a = Left(Cells(1), 3) Select Case a Case 100 oszlop = 5: k = 3: GoTo Szort Case 200 oszlop = 6: k = 3: GoTo Szort Case 300 oszlop = 13: k = 3: GoTo Szort Case 400 oszlop = 18: k = 3: GoTo Szort Case 500 oszlop = 7: k = 3: GoTo Szort End Select a = Left(Cells(1), 2) Select Case a Case 10 oszlop = 2: k = 2: GoTo Szort Case 20 oszlop = 3: k = 2: GoTo Szort Case 30 oszlop = 24: k = 2: GoTo Szort Case 40 oszlop = 17: k = 2: GoTo Szort Case 50 oszlop = 4: k = 2: GoTo Szort End Select a = Left(Cells(1), 1) Select Case a Case 1 oszlop = 21: k = 1: GoTo Szort Case 2 oszlop = 22: k = 1: GoTo Szort Case 3 oszlop = 23: k = 1: GoTo Szort Case 4 oszlop = 16: k = 1: GoTo Szort Case 5 oszlop = 1: k = 1: GoTo Szort End Select Szort: sz = Trim(Cells(1) & "") If Cells(6, oszlop) > "" Then usor = Cells(65536, oszlop).End(xlUp).Row Cells(usor + 1, oszlop) = Right(sz, Len(sz) - k) Else Cells(6, oszlop) = Right(sz, Len(sz) - k) End If End Sub