Function DopasujOdpowiednik(DinBG As String) Select Case DinBG Case "BA" DopasujOdpowiednik = "BG200" Case "BB" DopasujOdpowiednik = "BG200" Case "BC" DopasujOdpowiednik = "BG200" Case "BD" DopasujOdpowiednik = "BG200" Case "BE" DopasujOdpowiednik = "BG200" Case "BF" DopasujOdpowiednik = "BG200" Case "BG" DopasujOdpowiednik = "BG200" Case "BH" DopasujOdpowiednik = "BG200" Case "BJ" DopasujOdpowiednik = "BG200" Case "BX" DopasujOdpowiednik = "BG200" Case "CA" DopasujOdpowiednik = "BG600" Case "CB" DopasujOdpowiednik = "BG660" Case "CC" DopasujOdpowiednik = "BG610" Case "CD" DopasujOdpowiednik = "BG620" Case "CE" DopasujOdpowiednik = "BG620" Case "CF" DopasujOdpowiednik = "BG700" Case "CG" DopasujOdpowiednik = "BG260" Case "CH" DopasujOdpowiednik = "BG680" Case "DA" DopasujOdpowiednik = "BG600" Case "DB" DopasujOdpowiednik = "BG600" Case "DC" DopasujOdpowiednik = "BG640" Case "DD" DopasujOdpowiednik = "BG690" Case "DE" DopasujOdpowiednik = "BG600" Case "DF" DopasujOdpowiednik = "BG600" Case "EA" DopasujOdpowiednik = "BG100" Case "EB" DopasujOdpowiednik = "BG100" Case "EC" DopasujOdpowiednik = "BG110" Case "ED" DopasujOdpowiednik = "BG110" Case "EE" DopasujOdpowiednik = "BG110" Case "EF" DopasujOdpowiednik = "BG110" Case "EG" DopasujOdpowiednik = "BG170" Case "FA" DopasujOdpowiednik = "BG400" Case "FB" DopasujOdpowiednik = "BG410" Case "FC" DopasujOdpowiednik = "BG440" Case "FD" DopasujOdpowiednik = "BG410" Case "FE" DopasujOdpowiednik = "BG440" Case "FF" DopasujOdpowiednik = "BG440" Case "GA" DopasujOdpowiednik = "BG420" Case "GB" DopasujOdpowiednik = "BG420" Case "GC" DopasujOdpowiednik = "BG420" Case "GD" DopasujOdpowiednik = "BG420" Case "GE" DopasujOdpowiednik = "BG420" Case "GF" DopasujOdpowiednik = "BG420" Case "HA" DopasujOdpowiednik = "BG430" Case "HB" DopasujOdpowiednik = "BG430" Case "HC" DopasujOdpowiednik = "BG430" Case "HD" DopasujOdpowiednik = "BG430" Case "HE" DopasujOdpowiednik = "BG430" Case "HF" DopasujOdpowiednik = "BG430" Case "JA" DopasujOdpowiednik = "BG420" Case "JB" DopasujOdpowiednik = "BG420" Case "JC" DopasujOdpowiednik = "BG420" Case "JD" DopasujOdpowiednik = "BG420" Case "JE" DopasujOdpowiednik = "BG420" Case "JF" DopasujOdpowiednik = "BG420" Case "JG" DopasujOdpowiednik = "BG420" Case "KA" DopasujOdpowiednik = "BG450" Case "KB" DopasujOdpowiednik = "BG700" Case "KC" DopasujOdpowiednik = "BG450" Case "LA" DopasujOdpowiednik = "BG450" Case "LB" DopasujOdpowiednik = "BG450" Case "LC" DopasujOdpowiednik = "BG450" Case "LD" DopasujOdpowiednik = "BG450" Case "LE" DopasujOdpowiednik = "BG450" Case "MA" DopasujOdpowiednik = "BG170" Case "MB" DopasujOdpowiednik = "BG170" Case "MC" DopasujOdpowiednik = "BG170" Case "MD" DopasujOdpowiednik = "BG170" Case "ME" DopasujOdpowiednik = "BG600" Case "MF" DopasujOdpowiednik = "BG600" Case "NA" DopasujOdpowiednik = "BG650" Case "NB" DopasujOdpowiednik = "BG650" Case "NC" DopasujOdpowiednik = "BG650" Case "ND" DopasujOdpowiednik = "BG650" Case "NE" DopasujOdpowiednik = "BG650" Case "PA" DopasujOdpowiednik = "BG420" Case "PB" DopasujOdpowiednik = "BG420" Case "PC" DopasujOdpowiednik = "BG420" Case "PD" DopasujOdpowiednik = "BG420" Case "PE" DopasujOdpowiednik = "BG600" Case "PF" DopasujOdpowiednik = "BG420" Case "QA" DopasujOdpowiednik = "BG500" Case "QB" DopasujOdpowiednik = "BG500" Case "QC" DopasujOdpowiednik = "BG500" Case "QD" DopasujOdpowiednik = "BG500" Case "QE" DopasujOdpowiednik = "BG500" Case "RA" DopasujOdpowiednik = "BG500" Case "RB" DopasujOdpowiednik = "BG500" Case "RC" DopasujOdpowiednik = "BG120" Case "SA" DopasujOdpowiednik = "BG700" Case "SB" DopasujOdpowiednik = "BG700" Case "SC" DopasujOdpowiednik = "BG700" Case "SD" DopasujOdpowiednik = "BG700" Case "SE" DopasujOdpowiednik = "BG700" Case "SF" DopasujOdpowiednik = "BG700" Case "SG" DopasujOdpowiednik = "BG700" Case "TA" DopasujOdpowiednik = "BG700" Case "TB" DopasujOdpowiednik = "BG700" Case "TC" DopasujOdpowiednik = "BG700" Case "TD" DopasujOdpowiednik = "BG420" Case "TE" DopasujOdpowiednik = "BG420" Case "UA" DopasujOdpowiednik = "BG460" Case "UB" DopasujOdpowiednik = "BG460" Case "UC" DopasujOdpowiednik = "BG460" Case "DU" DopasujOdpowiednik = "BG460" Case "UE" DopasujOdpowiednik = "BG460" Case "UF" DopasujOdpowiednik = "BG460" Case Else DopasujOdpowiednik = "Nie znaleziono BG" End Select End Function Function NextFilled(rStart As Range) As Long NextFilled = rStart.EntireColumn.Find(What:="?*", After:=rStart, LookIn:=xlValues).Row If NextFilled <= rStart.Row Then NextFilled = 0 End Function Sub Baugruppiarka() Dim intLiczbaPozycji As Integer Dim strActiveWorksheet As String Dim temp As Integer Dim ostatniwiersz As Integer Dim zakres As String Dim komorka As Range Dim strtemp As String Dim ostatnianiepusta As Range '-----------------------PRZEPISYWANIE OBSZARU DOSTAWCY/STAMI DO KOLUMNY Z TL----------------------------------------------------------------------------------------------------------------------------------------------------------- zakres = "G6:G999" 'poczatkowe ustawienie zakresu, bedzie zmniejszane do petli strActiveWorksheet = ActiveSheet.Name ' nazwa aktualnego arkusza intLiczbaPozycji = Worksheets(strActiveWorksheet).Range("A6:A999").Cells.SpecialCells(xlCellTypeConstants).Count 'ilosc pozycji w zmianie For i = 1 To intLiczbaPozycji Range(zakres).Select Set komorka = Selection.Find(What:="Obszar dostawcy", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If komorka Is Nothing Then 'do it something Else Cells(komorka.Row, komorka.Column + 5).Value = komorka.Value ostatniwiersz = komorka.Row zakres = "G" & komorka.Row & ":G999" End If Next '--------------------------WPISYWANIE STADLER BUAGRUPPY ZAMIAST DIN BAUGRUPPY----------------------------------------------------------------------------------------------------------------------------------------------------------- 'Range("Q6").Value = DopasujOdpowiednik(Range("Q6").Value) Set ostatnianiepusta = Range("A6") strtemp = "Q" & ostatnianiepusta.Row For i = 1 To intLiczbaPozycji Range(strtemp).Value = DopasujOdpowiednik(Range(strtemp).Value) strtemp = "Q" & NextFilled(ostatnianiepusta) If i = intLiczbaPozycji Then Else Set ostatnianiepusta = Range("A" & NextFilled(ostatnianiepusta)) End If Next '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Range("A5").Select Range("A1").Select End Sub