Vordefinierte Tabellen updaten
18.11.2018 20:51:08
Richi
Mittels Makroaufzeichnung und ein paar wenigen Änderungen brachte ich das Programm "Update_selektierte_Tabellen" zum laufen.
Trotzdem macht es nicht ganz das was ich gerne hätte.
In Tabelle 2 wird Programm nicht ausgeführt,obschon die Referenz im Programm hinterlegt ist. Das Programm "Update_selektierte_Tabellen" soll von irgend einer Tabelle innerhalb des Worksheets aus gestartet werden können.
Kann mir da jemand helfen?
Liebe Gruess
Richi
https://www.herber.de/bbs/user/125471.xlsm
Sub Update_selektierte_Tabellen()
Dim Tabelle_01 As Variant
Dim Tabelle_02 As Variant
Dim Tabelle_03 As Variant
Dim Tabelle_04 As Variant
Tabelle_01 = "Tabelle1"
Tabelle_02 = "Tabelle2"
Tabelle_03 = "Tabelle3"
Tabelle_03 = "Tabelle4"
Application.Run _
"'Test Sortierung Gruppierung und Zellinhalt splitten - Kopie.xlsm'! _
Bearbeitung_Aktive_Tabelle"
Sheets(Tabelle_01).Select
Application.Run _
"'Test Sortierung Gruppierung und Zellinhalt splitten - Kopie.xlsm'! _
Bearbeitung_Aktive_Tabelle"
Sheets(Tabelle_02).Select
Application.Run _
"'Test Sortierung Gruppierung und Zellinhalt splitten - Kopie.xlsm'! _
Bearbeitung_Aktive_Tabelle"
Sheets(Tabelle_03).Select
Application.Run _
"'Test Sortierung Gruppierung und Zellinhalt splitten - Kopie.xlsm'! _
Bearbeitung_Aktive_Tabelle"
Sheets(Tabelle_04).Select
End Sub
Sub Bearbeitung_Aktive_Tabelle()
Dim lngLast As Long ' _
Hilfsvariable definieren
' _
Parameter definieren
Const FIRST_COLUMN As Long = 1 _
' Beginn Spalte "A"
Const LAST_COLUMN As Long = 7 _
' Ende Spalte "G"
Const FIRST_ROW As Long = 16 _
' Start Zeile
Const FIRST_SORT As Long = 2 _
' 1. Sort Spalte "B"
Const SECOND_SORT As Long = 3 _
' 2. Sort Spalte "C"
Const THIRD_SORT As Long = 1 _
' 3. Sort Spalte "A"
' _
Nur aktive Tabelle wird berechnet
With ActiveSheet
' _
Kopfzeile Beschriftung neuer Spalten
lngLast = Application.Max(FIRST_ROW, .Cells(.Rows.Count, FIRST_COLUMN).End(xlUp).Row)
.Cells(FIRST_ROW, LAST_COLUMN - 1) = "Untere Toleranz"
.Cells(FIRST_ROW, LAST_COLUMN) = "Obere Toleranz"
' _
Berechnen
With .Range(.Cells(FIRST_ROW + 1, LAST_COLUMN - 1), .Cells(lngLast, LAST_COLUMN - 1)) _
' Startzelle für Berechnung
.FormulaR1C1 = "=TRIM(LEFT(RC[-1],FIND(""/"",RC[-1])-1))*1" _
' Berechnung =GLÄTTEN(LINKS(E17;FINDEN("/";E17)-1))*1
'.Value = .Value _
' Gibt Formel als Zahl aus
End With
With .Range(.Cells(FIRST_ROW + 1, LAST_COLUMN), .Cells(lngLast, LAST_COLUMN)) _
' Startzelle für Berechnung
.FormulaR1C1 = "=TRIM(MID(RC[-2],FIND(""/"",RC[-2])+1,99))*1" _
' Berechnung =GLÄTTEN(TEIL(E17;FINDEN("/";E17)+1;99))*1
'.Value = .Value _
' Gibt Formel als Zahl aus
End With
End With
With ActiveSheet
lngLast = Application.Max(FIRST_ROW, .Cells(.Rows.Count, FIRST_COLUMN).End(xlUp).Row) ' _
Definieren Range
' _
Sortieren
.Range(.Cells(FIRST_ROW, FIRST_COLUMN), .Cells(lngLast, LAST_COLUMN)).Sort _
Key1:=.Cells(FIRST_ROW, FIRST_SORT), Order1:=xlAscending, _
Key2:=.Cells(FIRST_ROW, SECOND_SORT), Order1:=xlAscending, _
Key3:=.Cells(FIRST_ROW, THIRD_SORT), Order1:=xlAscending, _
Header:=xlYes, MatchCase:=True
End With
End Sub