Flett Excel-ark Bruke VBA

stemmer
2

Jeg har en Excel-skjema (Say OG.xls) som har noen data som allerede er i det med noen 5000 rader med overskrifter i den første raden og opp til en Kolonner. Denne Ingen rader (5000) endres ikke for et helt år. Nå har jeg 5 XL filer (Say A, B, C, D, E) og data fra disse filene må legges til dette OG-fil bare starte fra 5001st rad hver gang. Alle disse 5 filer har forskjellig ingen kolonner, men identisk med OG fil. Jeg må trekke data fra disse filene og plassere dem i OG fil. Fra fil A: Kolonne A, B, C, D, E, F, G og H går til kolonne F, G, T, U, V, W, X og Y OG.xls fil. Likeledes er de andre filer data må tas ut i henhold til den tilsvarende kolonne med OG.xls

Den andre fildata må legges rett under den neste raden hvor den File A er avsluttet. (Si etter fylling av data fra fil A nå den OG.xls har 5110 rader, Fil B data er å fylles fra 5111 m rad av OG XLS. Det samme følger for de andre filene også. dataene fra disse fem filer må fylles rad etter rad, men bør samsvare kolonnene som for OG.xls

Hver gang den samme operasjon blir gjentatt ved å fylle data fra 5001st rad av OG.xls. For enkelhets skyld kan vi ha alle disse filene i samme mappe.

Hvordan kan vi gjøre dette.

Vennligst hjelpe meg i denne !!! Også gi meg beskjed for noen avklaringer.

Publisert på 23/10/2008 klokken 00:15
kilden bruker
På andre språk...                            


3 svar

stemmer
1

Hvis du trenger en mer presice svaret, ville du trenger å prøve noe først, og deretter be om hjelp i området du har fått fast. Mitt forslag er at du begynner med; 1. Begynn å skrive et VBA script i OG.XLS, som et første skritt prøve å få tilgang til filen A.xls og lese kolonnene og lime dem (de kan i utgangspunktet være på ethvert sted i den rekkefølgen). 2. Når du er i stand til å gjøre dette, er neste skritt å se om du putter dataene i høyre kolonne (si 5000 i ditt eksempel) ved å sette opp riktig type variabler og bruke dem og økes dem. 3. Din neste skritt bør være å lese kolonneoverskriftene i A.XLS og finne dem OG.XLS og identifisere dem. I første omgang kan du begynne ved å gjøre en enkel streng sammenligning, senere kan du avgrense dette til å gjøre en VLOOKUP. 4. I løpet av denne prosessen, hvis du støter på noen bestemt problem, heve det slik at du vil få et bedre svar.

Noen fra samfunnet ville gå til omfanget av å skrive hele koden for deg.

Svarte 23/10/2008 kl. 03:07
kilden bruker

stemmer
1

Hvorfor kolonne A havne i kolonne F, og hvorfor C ende opp i T? Er det en regel rundt dette som den første raden er en overskrift med med den samme teksten i den?

Kanskje et bilde kan hjelpe.

Basert på hva jeg kan gjette, vil jeg kaste hvert ark i en RecordSet med meningsfulle feltnavn (du trenger å referere til Microsoft ActiveX Data Objects 2.8 Library). Når dette er gjort vil det være svært enkelt å legge til hver RecordSet og kaste dem inn i ett enkelt ark.

Du må være i stand til å finne den siste kolonnen og siste rad i hvert ark for å gjøre dette rent så ta en titt på Hvordan kan jeg finne den siste raden ...

Redigere...

Nedenfor er en ryddet opp eksempel på hvordan du kan gjøre hva du trenger i VBA. Djevelen er i detaljene som tomme ark, og hvordan man skal håndtere formler (dette ignorerer dem helt), og hvordan å flette du kolonner på en hensiktsmessig måte (igjen ignorert).

Dette har blitt testet i Excel 2007.

Option Explicit
Const MAX_CHARS = 1200



Sub MergeAllSheets()
  Dim rs As Recordset
  Dim mergedRS As Recordset
  Dim sh As Worksheet
  Dim wb As Workbook

  Dim fieldList As New Collection
  Dim rsetList As New Collection

  Dim f As Variant
  Dim cols As Long
  Dim rows As Long
  Dim c As Long
  Dim r As Long

  Dim ref As String
  Dim fldName As String
  Dim sourceColumn As String



  Set wb = ActiveWorkbook
  For Each sh In wb.Worksheets
    Set rs = New Recordset
    ref = FindEndCell(sh)
    cols = sh.Range(ref).Column
    rows = sh.Range(ref).Row

    If ref <> "$A$1" Or sh.Range(ref).Value <> "" Then '' This is to catch empty sheet
      c = 1
      r = 1
      Do While c <= cols
        fldName = sh.Cells(r, c).Value
        rs.Fields.Append fldName, adVarChar, MAX_CHARS
        If Not InCollection(fieldList, fldName) Then
          fieldList.Add fldName, fldName
        End If
        c = c + 1
      Loop
      rs.Open


      r = 2
      Do While r <= rows
        rs.AddNew
        c = 1
        Do While c <= cols
          rs.Fields(c - 1) = CStr(sh.Cells(r, c).Value)
          c = c + 1
        Loop
        r = r + 1
        Debug.Print sh.Name & ": " & r & " of " & rows & ", " & c & " of " & cols
      Loop
      rsetList.Add rs, sh.Name
    End If
  Next


  Set mergedRS = New Recordset
  c = 1
  sourceColumn = "SourceSheet"
  Do While InCollection(fieldList, sourceColumn) '' Just in case you merge a merged sheet
    sourceColumn = "SourceSheet" & c
    c = c + 1
  Loop
  mergedRS.Fields.Append sourceColumn, adVarChar, MAX_CHARS
  For Each f In fieldList
    mergedRS.Fields.Append CStr(f), adVarChar, MAX_CHARS
  Next
  mergedRS.Open

  c = 1
  For Each rs In rsetList
    If rs.RecordCount >= 1 Then
      rs.MoveFirst
      Do Until rs.EOF
        mergedRS.AddNew
        mergedRS.Fields(sourceColumn) = "Sheet No. " & c
        For Each f In rs.Fields
          mergedRS.Fields(f.Name) = f.Value
        Next
        rs.MoveNext
      Loop
    End If
    c = c + 1
  Next


  Set sh = wb.Worksheets.Add

  mergedRS.MoveFirst
  r = 1
  c = 1
  For Each f In mergedRS.Fields
    sh.Cells(r, c).Formula = f.Name
    c = c + 1
  Next

  r = 2
  Do Until mergedRS.EOF
    c = 1
    For Each f In mergedRS.Fields
      sh.Cells(r, c).Value = f.Value
      c = c + 1
    Next
    r = r + 1
    mergedRS.MoveNext
  Loop
End Sub

Public Function InCollection(col As Collection, key As String) As Boolean
  Dim var As Variant
  Dim errNumber As Long

  InCollection = False
  Set var = Nothing

  Err.Clear
  On Error Resume Next
    var = col.Item(key)
    errNumber = CLng(Err.Number)
  On Error GoTo 0

  '5 is not in, 0 and 438 represent incollection
  If errNumber = 5 Then ' it is 5 if not in collection
    InCollection = False
  Else
    InCollection = True
  End If

End Function


Public Function FindEndCell(sh As Worksheet) As String
  Dim cols As Long
  Dim rows As Long
  Dim maxCols As Long
  Dim maxRows As Long
  Dim c As Long
  Dim r As Long

  maxRows = sh.rows.Count
  maxCols = sh.Columns.Count

  cols = sh.Range("A1").End(xlToRight).Column
  If cols >= maxCols Then
      cols = 1
  End If


  c = 1
  Do While c <= cols

    r = sh.Cells(1, c).End(xlDown).Row
    If r >= maxRows Then
      r = 1
    End If

    If r > rows Then
      rows = r
    End If
    c = c + 1
  Loop

  FindEndCell = sh.Cells(rows, cols).Address

End Function
Svarte 23/10/2008 kl. 03:52
kilden bruker

stemmer
0

Jeg kommer over dette problemet når en av min klient kom til meg etter løsning å slå sammen sine lager lister som er lagret i mer enn 200 separate filer. Hvis du har funnet deg selv å være i samme posisjon som min klient; ikke bekymre deg, skrev jeg et enkelt program som gjør jobben. :) Sjekk linken nedenfor:

JMC Excel - Bli med, Flett, kombinere flere Excel ark eller Excel-arbeidsbøker

Hilsen, JeeShen Lee www.jeeshenlee.wordpress.com

Svarte 23/09/2010 kl. 09:32
kilden bruker

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more