Jump to content

excel sheet spalten auslesen


Der letzte Beitrag zu diesem Thema ist mehr als 180 Tage alt. Bitte erstelle einen neuen Beitrag zu Deiner Anfrage!

Empfohlene Beiträge

Hallo Gemeinde!

 

Es gibt eine Tabelle mit Spalten A-G.

Beispiel:

 

A B C D E F G

a1 b1 farbe1 farbe2 farbe3 farbe4 g1

a2 b2 farbe1 farbe2 farbe3 farbe4 g2

.

.

 

Diese Tabelle soll nach Ausführung eines Makros so aussehen:

 

A B C D

a1 b2 farbe1 g1

a1 b2 farbe2 g1

a1 b2 farbe3 g1

a1 b2 farbe4 g1

a2 b2 farbe1 g2

.

.

.

 

Das ganze soll nach dem Schema in Tabelle2 kopiert werden.

dieses makro schnipsel habe ich als vorlage genommen, komme aber nicht so recht weiter :(

 

Sub CopyPrim()

Quelle = "Tabelle1"

Ziel = "Tabelle2"

Yziel = 1

 

With Sheets(Quelle)

'Durchlaufe alle Zeilen der Quelle

For Yquelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row

'Durchlaufe 23x alle Spalten der Quelle

For i = 1 To 23

For Xquelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column

'Zellinhalt kopieren

Sheets(Ziel).Cells(Yziel, Xquelle) = .Cells(Yquelle, Xquelle)

Next

Yziel = Yziel + 1

Next

Next

End With

End Sub

Link zu diesem Kommentar

Hallo pfeffis,

 

ich habe nur Office 2000 da...

 

aber ich denke der Code sollte auch bei dir laufen...

 



Sub Makro1()
'
' Makro1 Makro
' Makro am 16.03.2009 von Dirk aufgezeichnet
'

'
istart = 1 'Bereich x-Achse Anfang
iend = 7 ' Bereich x-Achse Ende
izeilenew = 1
istartnew = 0

sheets_num = ActiveWorkbook.Sheets.Count
Sheets(2).Select
'MsgBox sheets_num

izeilenzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
' MsgBox izeilenzahl

For izeile = 1 To izeilenzahl
'MsgBox izeile
For ispalte = istart To iend
Sheets(2).Select
Range(Cells(izeile, istart), Cells(izeile, istart)).Select
' MsgBox istart, vbCritical, izeile
Selection.Copy
Sheets(1).Select
Select Case istart
Case iend
'MsgBox izeilenew
Range(Cells(izeilenew - istartnew, istartnew + 1), Cells(izeilenew, istartnew + 1)).Select
ActiveSheet.Paste
ihelper = izeilenew - istartnew + 1
Do While ihelper <= izeilenew
Cells(ihelper, 1).Value = Cells(izeilenew - istartnew, 1).Value
ihelper = ihelper + 1
Loop
izeilenew = izeilenew + 1
istart = istart + 1
Case Else
If istartnew > 2 Then
izeilenew = izeilenew + 1
Else
istartnew = istartnew + 1
End If
Range(Cells(izeilenew, istartnew), Cells(izeilenew, istartnew)).Select
ActiveSheet.Paste
istart = istart + 1
' MsgBox istartnew, vbCritical, izeilenew
End Select
Next
istart = 1
istartnew = 0
Next
Sheets(2).Select
Range(Cells(izeilenzahl, istart + 1), Cells(izeilenzahl, istart + 1)).Select
Selection.Copy
Sheets(1).Select
Range(Cells(1, 2), Cells(izeilenew - 1, 2)).Select
ActiveSheet.Paste
Range(Cells(1, 1), Cells(1, 1)).Select
End Sub


[/Code]

 

Ich habe halt von Tabelle2 auf Tabelle1 kopiert. Das sollte aber kein Problem sein...

 

Gruß

 

Dirk

Link zu diesem Kommentar

WoW. vielen Dank. Kleines Problemchen noch:

Die Werte sehen statt so

 

A B C D

a1 b2 farbe1 g1

a1 b2 farbe2 g1

a1 b2 farbe3 g1

a1 b2 farbe4 g1

 

so

 

A   B    C       D
a1 b2 farbe1
       farbe2
       farbe3 
       farbe4 

aus.

 

Sprich spalte g wird gar nicht übernommen und die werte werden nur einmalig beim Sprung in die nächste zeile übernommen. bei spalte b steht nun auch immer eine 1 als wert drinnen.

 

Stand vorm umwandeln:

 

A   B      C       D       E        F     G
a1 b1 farbe1 farbe2 farbe3 farbe4 g1
a2 b2 farbe1 farbe2 farbe3 farbe4 g2

 

Stand nach dem umwandeln:

 

A       B      C        D
a1     1    farbe1   
       1    farbe2
       1    farbe3 
       1    farbe4
a2     1    farbe1
       1    farbe2
... 

Link zu diesem Kommentar

Ich hänge mal meine Datei mit ran...

 

Die Befüllung der Spalten a und g erfolgt beim letzten Durchlauf pro Zeile(iend) der Quelltabelle.

 

Spalte b wird nach durchlauf der Schleifen auf Basis der letzten Zeile der Quelltabelle gefüllt.

Vielleicht sieht dein Blatt doch ein wenig anders aus :)

 

Vielleicht interpretiert dein Office den Code auch ein wenig anders.

 

Hilfreich könnten auch die msgboxen im Code sein. Nimm einfach die Kommentare raus, dann siehst du ja was passiert.

 

Gruß

 

Dirk

Neu Microsoft Excel-Arbeitsblatt.zip

Link zu diesem Kommentar

Hier noch ne Möglichkeit, angelehnt an Deinen Beispielcode:

 

Sub CopyPrim()
Dim varSpalte1 As Object
Quelle = "Tabelle1"
Ziel = "Tabelle2"
YZiel = 1

With Sheets(Quelle)
'Durchlaufe alle Zeilen der Quelle
 For YQuelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
'Durchlaufe 3. bis vorletzte Spalte der Quelle
   For XQuelle = 3 To .Cells.SpecialCells(xlCellTypeLastCell).Column - 1
'Zellinhalt umkopieren
     Sheets(Ziel).Cells(YZiel, 1) = .Cells(YQuelle, 1)
     Sheets(Ziel).Cells(YZiel, 2) = .Cells(YQuelle, 2)
     Sheets(Ziel).Cells(YZiel, 3) = .Cells(YQuelle, XQuelle)
     Sheets(Ziel).Cells(YZiel, 4) = .Cells(YQuelle, .Cells.SpecialCells(xlCellTypeLastCell).Column)
     YZiel = YZiel + 1
   Next
 Next
End With

End Sub

Link zu diesem Kommentar

Like this?

Sub CopyPrim()
Dim varSpalte1 As Object
Quelle = "Tabelle1"
Ziel = "Tabelle2"
YZiel = 1

With Sheets(Quelle)
'Durchlaufe alle Zeilen der Quelle
 For YQuelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
'Durchlaufe 3. bis vorletzte Spalte der Quelle
   For XQuelle = 3 To .Cells.SpecialCells(xlCellTypeLastCell).Column - 1
'Zellinhalt umkopieren
     If .Cells(YQuelle, XQuelle) <> "" Then
     Sheets(Ziel).Cells(YZiel, 1) = .Cells(YQuelle, 1)
     Sheets(Ziel).Cells(YZiel, 2) = .Cells(YQuelle, 2)
     Sheets(Ziel).Cells(YZiel, 3) = .Cells(YQuelle, XQuelle)
     Sheets(Ziel).Cells(YZiel, 4) = .Cells(YQuelle, .Cells.SpecialCells(xlCellTypeLastCell).Column)
     YZiel = YZiel + 1
     End If
   Next
 Next
End With

End Sub

Link zu diesem Kommentar
Der letzte Beitrag zu diesem Thema ist mehr als 180 Tage alt. Bitte erstelle einen neuen Beitrag zu Deiner Anfrage!

Schreibe einen Kommentar

Du kannst jetzt antworten und Dich später registrieren. Falls Du bereits ein Mitglied bist, logge Dich jetzt ein.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung jetzt entfernen

  Only 75 emoji are allowed.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor-Fenster leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

×
×
  • Neu erstellen...