Wie erstelle ich eine variable intelligente Tabelle?

Auswertung_und_VBA-Aufzeichnung - (Excel, makro, VBA)

1 Antwort

Was sind denn die Kriterien dafür, wo die Tabelle beginnt?

Schaden könnte es der Übersicht halber nicht, die Startzelle im Sheet zu benamsen (Bsp. "TabelleStart")

Dim rStart as Range
Set rStart = Range("TabelleStart")
...
rStart.Select
...

Du kannst natürlich auch probieren, die Startzelle zu finden:

Set rStart = Range("A1").End(xlDown).Offset(1, 0).End(xlDown)

Oder mit einer Schleife

For i=2 To 10000
  If Cells(i-1,1).Value = "" and Cells(i,1).Value <> "" Then
    Set rStart = Cells(i,1)
    Exit For
  End If
Next

Die folgende Zeile könntest du versuchen, wie folgt zu flexibilisieren:

ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$11:$N$853"), , xlYes).Name = _
"Abl.Schleifpuffer"
...Add(xlSrcRange, Range(rStart,Selection), , xlYes).Name = _
"Abl.Schleifpuffer"

Die Kriterien dafür sind das er die Tabelle anhand der "Betriebsmittel"-Nr. erkennt.

Nur kommt diese Benennung 2x in Spalte A vor, sodass er bestenfalls noch die benachbarte Spalte "Benennung FHMI" erkennen sollte.

oder man startet ab Zelle A5 um das zu umgehen.

0
@Phila86
  Dim i, j As Integer
  Dim rStart As Range
  Set rStart = Nothing
  For i = 1 To 100
    For j = 1 To 100
      If Cells(i, j).Value = "Betriebsmittel" And Cells(i, j + 1).Value = "Benennung FHMI" Then
        Set rStart = Cells(i, j)
        Exit For
      End If
    Next
  Next
  If rStart Is Nothing Then Debug.Print "Start nicht gefunden": Exit Sub
0
@Suboptimierer

Habe vielleicht noch Kriterien vergessen:

1. In Tabellenblatt (Abl.Schleifpuffer)

2. Nach den o.g. Kriterien suchen (Betriebsmittel und Benennung)

3. Erstelle Tabelle mit dem Namen (TabSchleifpuffer)

Mit dem Code so, komm ich nicht zu Rande:

Dim rStart As Range
Set rStart = Sheets("Abl.Schleifpuffer")

Dim i, j As Integer
Dim rStart As Range
Set rStart = Nothing
For i = 1 To 100
For j = 1 To 100
If Cells(i, j).Value = "Betriebsmittel" And Cells(i, j + 1).Value = "Benennung FHMI" Then
Set rStart = Cells(i, j)
Exit For
End If
Next
Next
If rStart Is Nothing Then Debug.Print "Start nicht gefunden": Exit Sub

ActiveSheet.ListObjects.Add(xlSrcRange, Range(rStart, Selection), , xlYes).Name = _
"TabSchleifpuffer"

wahrscheinlich, eher was zum lachen ^^

0
@Phila86

Du hast einen Teil deines Codes vergessen:

 rStart.Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
0
@Suboptimierer

Ich habe echt probieren müssen, aber nun scheint es sehr gut zu funktionieren. Vielen Dank.

Wärst du so nett und schaust nochmal drüber ob da nicht noch ein Fehler drin ist oder mir etwas zum Verhängnis werden kann?

Der Code lautet nun so:

Sub Makro1()
'
' Makro1 Makro
'

'

Sheets("Abl.Schleifpuffer").Select

Dim i, j As Integer
Dim rStart As Range
Set rStart = Nothing
For i = 1 To 100
For j = 1 To 100
If Cells(i, j).Value = "Betriebsmittel" And Cells(i, j + 1).Value = "Benennung FHMI" Then
Set rStart = Cells(i, j)

rStart.Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Exit For
End If
Next
Next
If rStart Is Nothing Then Debug.Print "Start nicht gefunden": Exit Sub

ActiveSheet.ListObjects.Add(xlSrcRange, Range(rStart, Selection), , xlYes).Name = _
"TabSchleifpuffer"

End Sub
1
@Phila86

Die folgenden drei Zeilen am besten unter "If rStart Is Nothing":

rStart.Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Sonst musst du halt noch beachten, dass der Anfang immer innerhalb der ersten 100 Zeilen und Spalten sein muss.

Man hätte auch mit Range().Find operieren können, mein Ansatz war aber nicht wesentlich unkomplizierter oder kürzer als der obige.

Für die Zukunft, wenn du fortgeschrittener bist, solltest du dir merken, dass man möglichst wenig mit der Selection arbeiten sollte, da es eine Bremse ist. Am besten immer eigene Range-Objekte verwenden.

Ansonsten sieht das gut aus. (y)

0

Eine kleine Bitte hätte ich noch, da ich nichts dazu finde:

Wie würde der Befehl dann lauten wenn ich die intelligente Tabelle wieder in einen normalen Bereich konvertieren möchte?

Ich wüsste es nur manuell.

0
@Phila86

Kurz gesagt: Mit "intelligenten Tabellen" kenne ich mich nicht aus. Das ist die einzige Zeile, in die ich mich einarbeiten müsste ;P

0

Kein Problem, dann frage ich wieder in die Runde ^^

1

Excel VBA automatisches Zellen Springen beschleunigen / optimieren

Hallo liebe Community,

ich habe mir ein Makro gebastelt, mit dem ich mithilfe von 3 Commandbuttons Fehlercodes in eine Tabelle eintragen kann. Der Button trägt dabei einen Wert innerhalb dieser Tabelle ein und springt dann in die nächste Zelle damit dort z.B. ein anderer Fehlercode eingetragen werden kann. Damit das ganze im Kreis läuft habe ich "Sprunngmarken" eingebaut- die Navigation funktioniert super- nur ist das ganze durch die active und select Befehle sehr langsam.

Die Frage wäre, wie man das ganze eleganter lösen könnte um die Navigation zu beschleunigen?

Anbei der Code, der in einem der Buttons steht:

Private Sub CommandButton1_Click()

With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With

ActiveCell.Value = "VA+" ActiveCell.Offset(0, 1).Select Dim Adresse As String 'Zellensprung Beginn'

Adresse = ActiveCell.Address

Select Case Adresse Case Is = "$G$26" Range("B27").Select

    Case Is = "$G$27"
        Range("B28").Select
    Case Is = "$G$28"
        Range("B29").Select
     Case Is = "$G$29"
        Range("B30").Select
        
         Case Is = "$G$30"
        Range("H26").Select
    
      Case Is = "$M$26"
        Range("H27").Select
        
        Case Is = "$M$27"
        Range("H28").Select
    
    
       Case Is = "$M$28"
        Range("H29").Select
    
          Case Is = "$M$29"
        Range("H30").Select
        
        Case Is = "$M$30"
        Range("N26").Select
        
    Case Is = "$S$26"
        Range("N27").Select
        
        Case Is = "$S$27"
        Range("N28").Select
        
        Case Is = "$S$28"
        
        Range("N29").Select
    
     Case Is = "$S$29"
        Range("N30").Select
    
     Case Is = "$S$30"
        Range("T26").Select
        
        Case Is = "$Y$26"
        Range("T27").Select
        
          Case Is = "$Y$27"
        Range("T28").Select
    
      Case Is = "$Y$28"
        Range("T29").Select
    
    Case Is = "$Y$29"
        Range("T30").Select
        
             Case Is = "$Y$30"
        Range("Z26").Select
        
        Case Is = "$AE$26"
        Range("Z27").Select
        
        Case Is = "$AE$27"
        Range("Z28").Select
        
        Case Is = "$AE$28"
        Range("Z29").Select
        
    Case Is = "$AE$29"
        Range("Z30").Select
      
    Case Else:
        ActiveCell.Select
        
End Select 'Zellensprung Ende'

With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With

End Sub

...zur Frage

Excel Makro! Wenn Zeile beschrieben, dann nächste Zeile... Wer kann mir bei diesem Problemchen behilflich sein?

Hallo,

ich möchte eine Exceltabelle für Artikel herstellen. Die Daten, die ich einfügen möchte, sind in Spaltenform gelistet ( von oben nach unten. Ich brauche die Daten jedoch in der Zeilenform. Um den Vorgang zu automatisieren habe ich ein Makro erstellt. Jedoch schreibt er mir die Daten immer in die gleiche Zeilen. Ich habe es leider, mit meinem Laienwissen, nicht hinbekommen eine "wenn, dann" Funktion einzufügen.

Meine Formel lautet folgendermaßen:

Sub Makro2()
'
' Makro2 Makro
'
' Tastenkombination: Strg+e
'
    Range("D23:D29").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("E9:K9").Select
    ActiveSheet.Paste
    Range("D23:D29").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub

Bei "Range("E9:K9").Select" brauche ich eine Funktion, die wenn der Wert zwischen E9:K9 besetzt/beschrieben sein sollte es dann auf E10:K10 die Daten einfügt.

Ich würde mich sehr freuen, wenn mir jemand mit meinem Problemchen behilflich sein könnte.

Vielen Dank

...zur Frage

beim kopieren von Zellen plötzlich nicht mehr leer

In Tabelle 1 in den Spalten Z:AB habe ich 1800 Redewendungen zu stehen. Wobei nicht jede Zelle mit Inhalten belegt ist. Dies hängt von meiner Eingabe ab. Ich gebe das Wort "Tisch" ein dann werden in den Spalten Z:AB alle Datensätze die das Wort Tisch enthalten angezeigt. Alle anderen sind leer. Mit dem Makro Übersetzung kopiere ich die Spalten Z:AB in die Tabelle 2. Spalte B:D. Dort sind sämtliche Zellen ohne Text leer. In Tabelle 4 A1 gebe ich ein =Tabelle2!B6 und ziehe das bis A1800. Nun der Efekt. in einigen Zellen, die leer sein sollten, steht eine Null. Die stört mich da ich an Hand der Spalte A dann die Leerzeilen ausblende, damit nur noch die Zeilen angezeigt werden, die auch Text besitzen. Nun meine Frage: Wie kommt es , das eine leere Zelle in der Tabelle 2 plötzlich in der Tabelle 4 mit einer Null belegt ist. Sämtliche Zellen sind mit Text formatiert.

Sub deutsch_polnische_Übersetzung() ' ' deutsch_polnische_Übersetzung Makro

'Übersetzen
    Sheets("Tabelle1").Select
    Columns("Z:AB").Select
    Selection.Copy
    Sheets("Tabelle2").Select
    Columns("B:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("B1").Select
    
    Sheets("Tabelle4").Select
    Range("a1").Select
End Sub

Hat jemand ne Idee

Gruß Monkee

...zur Frage

VBA: Verschiedene Formel je Bedingung?

Ich sitze leider schon länger dran aber mittlerweile habe ich ein Brett vor dem Kopf.

Ich versuche meine Frage mal wie folgt zu beschreiben:

Wenn in Spalte P Ein Eintrag Namens "Hans" Vorhanden ist, so soll in Spalte AF eine Formel A hintelegt werden.
Bei anderen Einträgen in Spalte P wird Formel B hinterlegt.

Ich schaffe es, die Formel A einzutragen und sie Funktioniert auch, aber Formel B wird komplett ignoriert, obwohl in Spalte P andere Namens als Hans erscheinen.

'Dim Ende As Long
'ActiveSheet.UsedRange.AutoFilter Field:=16, Criteria1:="HANS"
'Range("AF2").FormulaLocal = "=WENN(HEUTE()-AE2<=40;""OK"";""P"")"
'Ende = Cells.SpecialCells(xlCellTypeLastCell).Row
'Range("AF2").AutoFill Destination:=Range("AF2:AF" & Ende), Type:=xlFillDefault

'ActiveSheet.UsedRange.AutoFilter Field:=16, Criteria1:="<>HANS"
'Range("AF2").FormulaLocal = "=WENN(HEUTE()-AE2<=30;""OK"";""P"")"
'Ende = Cells.SpecialCells(xlCellTypeLastCell).Row
'Range("AF2").AutoFill Destination:=Range("AF2:AF" & Ende), Type:=xlFillDefault

Vorab lieben Dank und

Viele Grüße

...zur Frage

Werte aus Tabelle mit Makro archivieren?

Hallo Zusammen, ich habe mir ein Makro aufgezeichnet, welches Werte aus einer Tabelle in ein anderes Tabellenblatt kopiert. Die Werte in der Ursprungstabelle ändere ich aber ständig und ich will, dass beim aktivieren des Makros, die zuvor kopierten Werte nicht überschrieben werden sondern neben den bereits "archivierten" Werten eingefügt wird. So sieht das Makro bis jetzt aus:

Sub test() ' test Makro Range("C5:D19").Select Selection.Copy Sheets("Tabelle1").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Tabelle2").Select Range("A7:B8").Select Application.CutCopyMode = False Selection.Copy Sheets("Tabelle1").Select Range("A18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Tabelle2").Select Application.CutCopyMode = False Range("C7:C19").Select Selection.ClearContents Range("C7").Select Sheets("Tabelle1").Select Range("D2").Select Sheets("Tabelle2").Select End Sub

Problem ist, dass die alten Werte in dem neuen Tabellenblatt immer überschrieben werden. Könnt Ihr mir eine Funktion nennen, damit die Werte nicht überschrieben werden, sondern bei jedem mal ausführen des Makros die Werte in eine neue Spalte kopiert werden.

Vielen Dank im Voraus. Grüße Stephan

...zur Frage

Zelleninhalt mit Makro/ Vba verschieben

Moin,

ich hab folgendes Problem, und zwar möchte ich eine Makrofunktion erstellen mit der man den Zellinhalt einer markierten Zelle in eine andere frei wählbare Zelle kopieren kann. Bis jetzt sieht meine Funktion so aus:

Sub Makro()

Dim Quellbereich As Range Set Quellbereich = ActiveCell

Quellbereich.Copy Range("C1").Select Selection.PasteSpecial Paste:=x1Values, Operation:=x1None, SkipBlanks:= False, Transpose:=False Application.Cutcopymode = False Quellbereich.Select Quellbereich = "" Range("C1").Select

End Sub

Jetzt ist meine Frage, wie ich "Range("C1") auch über die Auswahl mit der Maus steuern kann. Ich stell mir das mit Pause/Wait und Input neue Zellenauswahl oder so vor. Evnt. auch das man das Makro wie bisher über Strg+y startet und anschließend die Quell und die Zielzelle nach einander markiert.

...zur Frage

Was möchtest Du wissen?