Wątek przeniesiony 2021-09-16 10:19 z Inne języki programowania przez cerrato.

Sortowanie VBA

0

Hej,
chcę skopiować dane z wielu arkuszy .xlsm do jednego arkusza. Dane powinny wyświetlać się w określonej kolejności (wg. kwoty wydatków - od najmniejszej do największej). Kwoty te znajdują się komórce G3 źródła. Dodam, iż wartości powinny być posotowane wg wartości, które znajdują się w co drugim wierszu kolumny pliku docelowego. Zdjęcie pliku docelowego w załączniku. Poniżej kod:

Kod:

Sub simpleXlsMerger() 
Dim bookList As Workbook 

Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False 
Set mergeObj = CreateObject("Scripting.FileSystemObject") 
  
'change folder path of excel files here 
Set dirObj = mergeObj.Getfolder("C:\billings") 
Set filesObj = dirObj.Files 
For Each everyObj In filesObj 
Set bookList = Workbooks.Open(everyObj) 
  
'change "A2" with cell reference of start point for every files here 
'for example "B3:IV" to merge all files start from columns B and rows 3 
'If you're files using more than IV column, change it to the latest column 
'Also change "A" column on "A65536" to the same column as start point 
'Range("B1:H5" & Range("B1").End(xlUp).Row).Copy 

Range("D2", "G3").Copy 
ThisWorkbook.Worksheets(1).Activate 
  
'Do not change the following column. It's not the same column as above 

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial 
Application.CutCopyMode = False 
bookList.Close SaveChanges:=False 

Next 
End Sub

Ogromna prośba o pomoc.
Z góry dziękuję.

0

W skrócie masz taki układ i dodajesz kolumnę lp i kwota:

pic.PNG

Uruchamiasz jak poniżej:

Sub Sort()
    Range("A2:D7").Select
    
    Selection.Sort Key1:=Range("D:D"), Order1:=xlAscending, Key2:=Range("C:C") _
            , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
            False, Orientation:=xlTopToBottom
    Range("A1").Select
End Sub

I masz taki wynik (kwestia usunięcia dodatkowych kolumn lp i kwota):
pic2.PNG

1 użytkowników online, w tym zalogowanych: 0, gości: 1