Hey Pokernet og Pokernets Excel hajer!
Jeg har en masse data fordelt i 760 faner i samme excel ark (jeg har tidligere haft 760 separate ark, men har nu fået konsolideret dem i et ark). Jeg vil gerne have alle data samlet i en fane, men problemet er at data i de forskellige faner ikke står på samme måde i alle faner, f,eks;
Fane 1
Varenummer - antal - pris
XXX - XXX - XXX
Fane 2
Antal - varenummer - pris
XXX - XXX - XXX
osv osv osv, der er ialt ca. 10 overskrifter jeg gerne vil have samlet date fra, så jeg ender med at have 1 fane, hvor alle varenumrene er samlet i kolonne 1, antal i kolonne 2 osv. Jeg kan finde ud af det hvis alle data var i de samme kolonner i alle fanerne, men jeg er lidt på bar bund, når date er sorteret forskelligt i fanerne.
Er der nogen der kan gennemskue det og hjælpe med en løsning?
På forhånd tak!
/Champen81
Excel data konsolidering
Jeg har skrevet dig en lille makro, der sorterer overskrifterne i fanebladene i alfabetisk orden.. Den burde virke, hvis det kun er de 3 første kolonner, der er data i, og alle overskrifter ligger i række 1. Ellers skal den lige tilpasses lidt, og så må du lige sige til, hvis du ikke selv kan det.
Sub SortSheets()
For i = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(i).Sort.SortFields.Clear
ThisWorkbook.Sheets(i).Sort.SortFields.Add Key:=Range("A1:C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ThisWorkbook.Sheets(i).Sort
.SetRange Range("A1:C1000000")
.Header = xlYes
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Next i
End Sub
EDIT. Den snupper kun en million rækker i sorteringen, så hvis du har over, må du også lige melde tilbage.
Fedt, det havde jeg overhovedet ikke tænkt på. Det eneste problem er, at jeg har nogle overskrifter i nogle af fanerne, som jeg ikke har med i andre faner, så når jeg samler alle fanerne til sidst, bliver resultatet stadig, at de ikke bliver samlet i de rigtige kolonner, f.eks
fane1
X1 X2 X3 X4 X5 X6 X7 X12 X17
Fane2
X1 X2 X3 X4 X5 X6 X7 X13 X19
Fane3
X1 X2 X3 X5 X6 X7 X12 X19
Fane 4
X3 X4 X5 X6 X7 X13 X17
Nogen ide til hvordan det så kan løses?
Jeg går ud fra, at du bruger en makro til konsolidere i et enkelt faneblad. Kan du ikke lige poste den, så forsøger jeg lige at finde ud af et eller andet.
Ja, det er denne;
Sub Combine()
Dim NumSheets As Integer
Dim NumRows As Integer
NumSheets = 757
NumRows = 40
Worksheets(1).Select
Sheets.Add
ActiveSheet.Name = "Consolidated"
For X = 1 To NumSheets
Worksheets(X + 1).Select
Rows("1:" & NumRows).Select
Selection.Copy
Worksheets("Consolidated").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Worksheets(X + 1).Select
Range("A1").Select
Next X
Worksheets("Consolidated").Select
Range("A1").Select
End Sub
Og tusind tak for din hjælp!
Hvorfor ikke bruge excels indbyggede konsolideringsfunktion under fanen Data?
Jeg må ærligt indrømmet, at jeg aldrig rigtig er nået til den funktion i min excelbog, men er det ikke problematisk, at der skal konsolideres fra 750 faner? Jeg ville tro, at det krævede en frygtelig masse manuelt arbejde. Oplys mig dog endelig, hvis der er noget, jeg har overset.
Edit. Og kan den andet end at summere? Der kan vel være forskellige varenumre i de forskellige faner.
Det kræver at man manuelt går ind og vælger samtlige 750 faner, men så har den også selv gjort alt arbejdet. Man kan selv bestemme om den skal tælle, lægge sammen, gennemsnit osv.
den makro jeg kører har jeg 10K rækker med, og ikke 40 som i den jeg postede ovenfor.
@Badehat
Samme spørgsmål som mambo_err. Der er for meget manuelt arbejde i at skulle vælge 750 faner manuelt. Og den skal ikke lægge noget sammen, men samle date fra de andre ark.
Nå, det tog jo lidt længere tid end forventet. Alt det kræver er, at du har alle overskrifterne. Disse sætter du så ind i et tomt første ark (det vil sige arket skal være det første i workbooken, meget vigtigt), eksempelvis
Varenummer Antal Pris X Y
Antallet af overskrifter angiver du i NumHeaders. Skal du have flere rækker med, kan dette også ændres i NumRows. Kør makroen og meld fejl op her.
Sub Konsolider()
Dim NumSheets, NumHeaders As Integer
Dim NumRows As Integer
Dim i, iColumn As Integer
Dim FindString As String
Dim Rng As Range
Dim LastRow As Long
Application.ScreenUpdating = False
StatusBar = "Makroen er aktiv"
NumSheets = ThisWorkbook.Sheets.Count
NumRows = 10000
NumHeaders = 20
For i = 2 To NumSheets
For j = 1 To NumHeaders
FindString = ThisWorkbook.Sheets(1).Cells(1, j).Value
If Trim(FindString) <> "" Then
With ThisWorkbook.Sheets(i).Range("1:1")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If Not Rng Is Nothing Then
With Sheets(1)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
iColumn = Rng.Column
ThisWorkbook.Sheets(i).Select
ActiveSheet.Range(Cells(2, iColumn), Cells(NumRows, iColumn)).Copy
ThisWorkbook.Sheets(1).Cells(LastRow + 1, j).PasteSpecial xlValues
End If
End If
Next j
Next i
ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = True
StatusBar = ""
End Sub
Edit. jeg kom lige i tanke om en vigtig ændring ift. indsættelse i konsolideringsark.
Super fedt at du bruger tid på at hjælpe!
Kan jeg nøjes med at "pille" 6 overskrifter ud jeg vil have data på (der er noget data jeg er ligeglad med)? eller skal jeg liste samtlige overskrifter?
Det var så lidt, det går kun ud over mit speciale, så ingen problemer.
Ja, det burde du kunne, men prøv dig lidt frem. Fandt lige en kritisk fejl mere, så du får en ny version her:
Sub Konsolider()
Dim NumSheets, NumHeaders As Integer
Dim NumRows As Integer
Dim i, iColumn As Integer
Dim FindString As String
Dim Rng As Range
Dim LastRow As Long
Application.ScreenUpdating = False
StatusBar = "Makroen er aktiv"
NumSheets = ThisWorkbook.Sheets.Count
NumRows = 10000
NumHeaders = 20
For i = 2 To NumSheets
With Sheets(1)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For j = 1 To NumHeaders
FindString = ThisWorkbook.Sheets(1).Cells(1, j).Value
If Trim(FindString) <> "" Then
With ThisWorkbook.Sheets(i).Range("1:1")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If Not Rng Is Nothing Then
iColumn = Rng.Column
ThisWorkbook.Sheets(i).Select
ActiveSheet.Range(Cells(2, iColumn), Cells(NumRows, iColumn)).Copy
ThisWorkbook.Sheets(1).Cells(LastRow + 1, j).PasteSpecial xlValues
End If
End If
Next j
Next i
ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = True
StatusBar = ""
End Sub
Det virker perfekt! Tusind tak og undskyld på dit speciales vegne :-)
Det var lige præcis hvad jeg skulle bruge.
jeg giver en stor kold øl hvis du er i Brønshøj en dag :-)
Super, jeg giver lige lyd fra mig, hvis jeg er tørstig på de kanter en dag.
To ting der kan give fejl, som du ikke ville opdage:
Stavefejl i overskrifterne i de forskellige ark. Atal i stedet for antal osv. vil gøre, at de ikke bliver flytte over, da makroen identificerer på tekststrenge - dog er den ikke casesensitiv.
Hvis der er tomme celler i det, du tæller på i første kolonne, kan der gå noget data tabt. Dette sker da makroen finder sidst anvendte række i kolonne 1, og så sætter data fra den næste fane ind på lastrow + 1.