Új hozzászólás Aktív témák

• #48858 Delila_1 Topikgazda Salex1 #48857

  Új Válasz 2022-04-22 10:09:17 #48858

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  Topikgazda

  válasz Salex1 #48857 üzenetére

  A mintád alapján írtam egy makrót, ami a Munka2 lapra írja az első kép adatait a második képed szerint . A makrót modulba másold, a füzetet makróbarátként kell elmentened.

  Sub Atrendez()
    Dim oszlop As Integer, uoszlop As Integer, ide As Long, sor, usor As Long
    
  Range("V:BB").ClearContents
    Sheets("Munka2").Range("A:E").ClearContents
    
    usor = Range("E" & Rows.Count).End(xlUp).Row
    Range("D1:D" & usor).Copy Range("V1")
    With Range("V1:V" & usor)
        .Replace What:="W", Replacement:=",0"
        .Replace What:=",0", Replacement:="W"
        .Replace What:="[", Replacement:=""
        .Replace What:="]", Replacement:=""
        .Replace What:="'", Replacement:=""
        .TextToColumns Destination:=Range("V1"), Comma:=True
    End With
    
    Range("V1", ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Replace What:="W", Replacement:=",0"
    Cells(1).Select
    
    ide = 1
    For sor = 1 To usor
        uoszlop = Cells(sor, Columns.Count).End(xlToLeft).Column
        With Sheets("Munka2")
            For oszlop = 22 To uoszlop
                Range("A" & sor & ":C" & sor).Copy .Range("A" & ide)
                .Range("D" & ide) = Cells(sor, oszlop)
                .Range("E" & ide) = Cells(sor, "E")
                ide = ide + 1
            Next
        End With
    Next
  Range("V:BB").ClearContents
    Sheets("Munka2").Select
    Cells(1).Select
End Sub

  [ Szerkesztve ]

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

Új hozzászólás Aktív témák