Anzeige
Archiv - Navigation
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
548to552
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabellen neu formatieren

Tabellen neu formatieren
19.01.2005 11:27:57
Luigi
Hallo Leute!
Ich möchte verschiedene Tabellen innerhalb eines Blattes dynamisch neu formatieren. Die Tabellen sind in der Originalversion nach Produkttyp aufgebaut (siehe bitte Link!). Mein Cheh will sie aber unbedingt nach dem Entwicklungsjahr haben!!!!!
https://www.herber.de/bbs/user/16371.zip
Weiss jemand wie ich das machen kann (am besten ohne Hilfe eines zweiten Blattes!)
Vielen Dank im Voraus!
Luigi

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellen neu formatieren
19.01.2005 12:59:48
DieterB
Hallo Luigi,
sind die Tabellen im Original umfangreicher?
ich würde sagen:
jeden Fall einzeln ausschneiden und neu einfügen.
Gruß
DieterB
AW: Tabellen neu formatieren
20.01.2005 01:14:54
Luigi
Hi DieterB! Ich habe es versucht, aber es kommt nichts Gutes raus! Was mache ich denn falsch? Gruss!
Luigi
Public

Sub Tabellen_neu_formatieren()
Dim c As Range
Dim be As Range
Dim i As Integer
Dim z As Integer
Dim suchIndex As Integer
Dim entwicklungsjahre
Dim wks As Worksheet
Dim Tabellenbezeichnung As String
z = 11
entwicklungsjahre=Array(“1999”,”2002”,”2003”,”2005”)
Set wks = Worksheets("Original")
ThisWorkbook.IsAddin = False
wks.Select
wks.Cells(10, 1).Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Application.ScreenUpdating = False
For i = 0 To UBound(Entwicklungsjahre) Step 1
suchIndex = 15
Cells(z, 1).Value = Entwicklungsjahre(i)
Do
Set c = Cells.Find(What:=Entwicklungsjahre(i), After:=Cells(suchIndex, 1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
‘ Range be!!! Damit suche ich die Tabellenbeschreibung in 'der Spalte A (z. B: Produkt A)
Set be = Cells(c.Row, c.Column - 2)
Do
If be Is Nothing Then Exit Do
Set be = Cells(be.Row - 1, be.Column)
Loop While (IsEmpty(be.Value))
Cells(z + 1, 2).Value = be.Value
Range(Cells(c.Row, c.Column - 1), Cells(c.Row, c.Column + 2)).Select: Selection.Cut
On Error Resume Next
'ActiveSheet.Paste Destination:=Worksheets("Original").Range(Cells(z + 2, 2), Cells(z + 2, 5))
ActiveSheet.Paste Destination:=Worksheets("Original").Cells(z + 2, 2)
Cells(z + 4, 1).Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
suchIndex = c.Row + 4
z = z + 6
End If
Loop Until c Is Nothing
Next i
ThisWorkbook.IsAddin = False
Worksheets("Original").Select
Application.CutCopyMode = False
Set c = Nothing
Set be = Nothing
Application.ScreenUpdating = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige