Makro zum Zusammenfassen von Spalten

Hallo alle zusammen,

ich hab ein kleines Problem mit einem Makro, welches ich mir mit Hilfe diverser Quellen versucht habe auf meinen Fall zusammenzuschustern. Folgendermaßen kann man sich die Grundsituation vorstellen:

Ich habe in den Spalten D Und E ca 70 Zeilen mit Einträgen. Bis auf die Zellen 11 - 14 Ist die Spalte E leer. Also wollte ich ein Makro benutzen, welches die Spalte D wenn D und/oder E leer sind mit E zusammenfasst und sonst nicht.

Das soll dann auch für die Spalten F,G und H,I und immer soweiter klappen. Wer könnte mir Helfen und zeigen wo mein Fehler liegt denn bisher funktioniert das Makro nicht ganz so wie ich mir das vorgestellt habe.

Sub Formatierung()

Dim Zeile As Integer Dim Spalte As Integer

For Spalte = 4 To 256 Step 2
For Zeile = 1 To 100

If ((Not (IsEmpty(Cells(Spalte, Zeile)))) = True And IsEmpty(Cells(Spalte + 1, Zeile)) = True) Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

If IsEmpty(Cells(Spalte, Zeile)) = True And IsEmpty(Cells(Spalte + 1, Zeile)) = True Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

Next Zeile

Next Spalte

End Sub

So sieht das bisher aus. Für jede Hilfe vorab schonmal besten Dank

2 Antworten

Oubyi, UserMod Light

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

11.04.2012, 17:21

Ok, dass in dem Code Spalte und Zeile durcheinander gewirbelt werden, habt ich schließlich auch gemerkt.
Nur noch eine allgemeine Bemerkung:
Jeder Profi sagt Dir:
"Lass die Finger von verbundenen Zellen, dass gibt nur Probleme".
Excel kann mit verbundenen Zellen nicht wirklich vernünftig umgehen, und gerade in VBA wird die Fehlersuche dabei SEHR erschwert.
Also überlege Dir, ob das wirklich sein muss, oder ob es vielleicht reicht, die Werte von Spalte E in Spalte D zu schreiben, wenn die leer ist.
Oder vielleicht macht es Sinn einfach Alles in Spalte D zu schreiben, sodass E leer bleibt (und evtl. sogar gelöscht werden kann). Macht allerdings nur bei Text wirklich Sinn.
Das könnte dann so gehen:

Sub Formatierung()

Dim Zeile As Integer
Dim Spalte As Integer

For Spalte = 4 To 256 Step 2
For Zeile = 1 To 100

Cells(Zeile, Spalte).Value = Cells(Zeile, Spalte).Value _
& "_" _
& Cells(Zeile, Spalte + 1).Value

Cells(Zeile, Spalte + 1).ClearContents

Next Zeile
Next Spalte
End Sub

Das
& "_" _
kannst Du auch weglassen, wenn Du kein Verbindungszeichen haben willst, oder durch
& " " _
für ein Leerzeichen oder durch ein anderes Zeichen ersetzen.

Woher ich das weiß:Berufserfahrung – IT-Administrator (i.R.)

Iamiam

11.04.2012, 19:30

anstatt Zellen verbinden kannst u die Formatierung 'über Auswahl zentrieren' wählen, für beide Zellen. Wenn dann in der zweiten Spalte was steht, wird das automatisch getrennt wiedergegeben, ganz ohne Makro! Makros sind nur was für Probleme, für die xl standardmäßig keine Lösung anzubieten hat oder für Abfolgen von Befehlen!

Oubyi, UserMod Light

12.04.2012, 16:42

@Iamiam

@lamiam: DAS ist auf jeden Fall auch eine gute Idee!!!

IzmirWurscht

Fragesteller

12.04.2012, 10:26

Vielen Dank erstmal für deinen Vorschlag. Das Funktioniert so ja eigentlich schon ganz gut, nur hab ich in den Zeilen 11 - 14 leider Zahlen stehen. Diese sind in der Form von ... bis... und daher absichtlich in 2 Spalten. Der Versuch For Zeile 1 To 10

For Zeile1 15 To 100 funktioniert leider nicht.

Und dann hab ich probiert die Lösung von Suboptimierer mit deinem Vorschlag zu kombinieren, aber da wills auch nicht klappen. Ich hab gedacht das müßte dann so aussehen: Sub Formatierung()

Dim Zeile As Integer Dim Spalte As Integer

For Spalte = 4 To 256 Step 2
For Zeile = 1 To 100


Set zelle1 = Cells(Zeile, Spalte)
Set zelle2 = Cells(Zeile, Spalte + 1)

 If IsEmpty(zelle1) Or IsEmpty(zelle2) Then
'Range(zelle1, zelle2).Merge 'Lösung von Suboptimierer
Cells(Zeile, Spalte).Value = Cells(Zeile, Spalte).Value & "" & Cells(Zeile, Spalte  + 1).Value

Cells(Zeile, Spalte + 1).ClearContents

End If

Next Zeile Next Spalte

End Sub

Da wills aber auch nicht so wie ich will

Iamiam

12.04.2012, 13:32

@IzmirWurscht

Es wäre immer schön, zu wissen, ob der Frager sowas als Übungsbeispiel fürs Makrolernen sieht oder als echtes Problem: im ersten Fall würde ich natürlich auf Vorschläge wie meinen o.g. verzichten.
Im zweiten bin ich der Meinung, dass der Aufwand alletr Beteiligten hier in keinem Verhältnis mehr zum Nutzen steht.
Eine Formellösung (neue Spalte F einfügen, da in F1 die Formel =D1&E1, runterziehen, Spalte kopieren, als Werte einfügen und dann beliebig D1 und/oder E1 löschen: das wäre einfacher gewesen!)
ggf auch verbunden mit der Abfrage wenn(istzahl(..)...) oder isttext etc

Oubyi, UserMod Light

12.04.2012, 16:46

@IzmirWurscht

Wenn Du in den Zeilen 11 bis 14 Zahlen von - bis hast, dann nutze meinen Code und nimm halt :
& "-" _
als Trennzeichen.
Ich glaube aber, langsam verstehe ich endgültig nicht mehr, was Du erreichen willst.
Am Besten, Du zeigst hier (in einer neuen Antwort) Screenshots von Teilen Deiner Liste VORher und NACHher, dann kann Dir sicherlich geholfen werden.

Suboptimierer

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

11.04.2012, 14:56

welches die Spalte D wenn D und/oder E leer sind mit E zusammenfasst und sonst nicht.

Bisher wird der Merge aber nur dann ausgeführt, wenn die erste Spalte ungleich leer ist, aber die zweite leer ist oder wenn beide Spalten leer sind.

Die zweite Abfrage würde ich so anpassen, dass gefragt wird, ob die erste Zelle leer ist, aber die andere nicht.

Du kannst aber auch beide Abfragen zusammenfassen; also wenigstens eine Zelle muss leer sein. Übrigens: "=True" kannst du dir schenken.

Ich versuche mal ungetestet ein Beispiel:

If IsEmpty(Cells(Spalte, Zeile)) or _
   IsEmpty(Cells(Spalte + 1, Zeile)) Then

IzmirWurscht

Fragesteller

11.04.2012, 15:08

Bisher wird der Merge aber nur dann ausgeführt, wenn die erste Spalte ungleich leer ist, aber die zweite leer ist oder wenn beide Spalten leer sind.

Also es soll so sein das wenn in der ersten Spalte was steht und in der Zweiten nicht, dann zusammenfassen, steht in beiden nichts auch zusammenfassen, steht in beiden was nicht zusammenfassen. Hab mich da wohl etwas unklar ausgedrückt.

Die Anderen Tipps versuch ich mal uzusetzen, Besten Dank

Suboptimierer

11.04.2012, 15:53

@IzmirWurscht

Also es soll so sein das wenn in der ersten Spalte was steht und in der Zweiten nicht, dann zusammenfassen, steht in beiden nichts auch zusammenfassen, steht in beiden was nicht zusammenfassen.

Es fehlt hier die Berücksichtigung des Falls, dass in der zweiten Spalte etwas steht, aber in der ersten nicht.

Nehmen wir an, dann sollte nicht zusammengefasst werden. Dann müsstest du doch nur dann zusammenfassen, wenn in der zweiten Spalte nichts steht. Habe ich das richtig verstanden?

If IsEmpty(Cells(Spalte + 1, Zeile)) Then

Es gibt insgesamt 4 Fälle:

Spalte 1  Spalte 2
leer      voll
leer      leer
voll      voll
voll      leer

IzmirWurscht

Fragesteller

11.04.2012, 16:26

@Suboptimierer

Sorum an die Sache zu gehen kam mir bisher nicht in den Sinn, naja. Eigentlich immer zusammenfassen, außer Spalte2 ist voll, dann solls getrennt bleiben. Habs auch grad mal probiert, gibt aber leider die gleichen Probleme, wie bei meinem Schriebs von vor einigen Minuten. Ich verstehe nicht warum das Makro auch jetzt offensichtlich volle Spalten zusammenfasen will.

Suboptimierer

11.04.2012, 16:44

@IzmirWurscht

Dafür reicht die alleinige Abfrage

if IsEmpty(Cells(Spalte + 1, Zeile)) Then

Ich glaube, wir haben inzwischen alle Möglichkeiten durchgekaspert ^^

Suboptimierer

11.04.2012, 16:57

@Suboptimierer

Korrigiere:

if IsEmpty(Cells(Zeile, Spalte + 1)) Then

IzmirWurscht

Fragesteller

11.04.2012, 16:03

Besten Dank erstmal für die Hilfe, ich hab jetzt nur noch 2 kleine Probleme. Zuerst will das Makro auch Zellen zusammenfassen in den in Spalte D und E gleichzeitig Einträge vorhanden sind, gerade das soll ja nicht passieren. Und dann wills einfach nicht Spalte D und E in Zeile 2 und 3 zusammenfassen.

Sub Formatierung()

Dim Zeile As Integer Dim Spalte As Integer

For Spalte = 4 To 256 Step 2
For Zeile = 1 To 100

If Not (IsEmpty(Cells(Spalte, Zeile))) And IsEmpty(Cells(Spalte + 1, Zeile)) Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

If IsEmpty(Cells(Spalte, Zeile)) Or IsEmpty(Cells(Spalte + 1, Zeile)) Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge

'If IsEmpty(Cells(Spalte, Zeile)) And IsEmpty(Cells(Spalte + 1, Zeile)) Then
'Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

Next Zeile

Next Spalte

End Sub

So sieht das jetzt aus, Falls noch jemand ne Idee hat wo das Problem liegt, wäre ich sehr Dankbar

Suboptimierer

11.04.2012, 16:29

@IzmirWurscht

Das Problem ist, dass bei Zellen, die durch die erste Abfrage zusammengeführt wurden, die zweite Abfrage den zweiten Zellwert als empty interpretiert.

Außerdem vertauscht du Zeile und Spalte gleich zweimal, ist das Absicht?:

If Not (IsEmpty(Cells(*Spalte*, *Zeile*))) And IsEmpty(Cells(*Spalte + 1*, *Zeile*)) Then
Range(Cells(*Zeile*, *Spalte*), Cells(*Zeile*, *Spalte + 1*)).Merge
End If

Die erste Abfrage ist überflüssig.

Ich habe folgendes probiert und es funktionierte prima:

  Set zelle1 = Cells(Zeile, Spalte) 
  Set zelle2 = Cells(Zeile, Spalte+1)

  If IsEmpty(zelle1) Or _
     IsEmpty(zelle2) Then
    Range(zelle1, zelle2).Merge
  End If

IzmirWurscht

Fragesteller

11.04.2012, 16:40

@Suboptimierer

Ich hab das dumpfe Gefühl das war eher keine Absicht, ich hab halt eher rumprobiert. Und so hats dann im Ansatz schon das gemacht wie ichs mir vorgestellt habe. Aber mit dem, was hier zuletzt gepostet wurde funktionert das wunderprächtig. Tausend Dank an Dich Suboptimierer

Hallo zusammen,

Ich habe ein Makro geschrieben, mit welchem jeweils via Button eine neue Spalte eingefügt wird.

Über den Button Spalten entfernen wird die jeweils ausgewählte Spalte gelöscht.

Private Sub CmdSpaltePlus_Click() 'Test Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "Perfektion"

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

 

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

 

Private Sub CmdPerfektionPlus_Click() 'Perfektion Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "F.n.B."

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

Spalten löschen

Private Sub Kompetenzenentfernen_Click() 'Spalten löschen

ActiveSheet.Unprotect Password:="MNPS"

If Cells(5, ActiveCell.Column) = "Schicht" Or Cells(5, ActiveCell.Column) = "Nr." Or Cells(5, ActiveCell.Column) = "Name" Or Cells(3, ActiveCell.Column) = "A1" Or Cells(3, ActiveCell.Column) = "D1" Or Cells(9, ActiveCell.Column) = "." Or Cells(3, ActiveCell.Column) = "E1" Or Cells(3, ActiveCell.Column) = "F1" Or Cells(3, ActiveCell.Column) = "G1" Or Cells(3, ActiveCell.Column) = "H1" Or Cells(2, ActiveCell.Column) = "." Or Cells(1, ActiveCell.Column) = "Zielwert" Then

MsgBox "Spalte kann nicht gelöscht werden"

Else

Selection.EntireColumn.Delete Shift:=xlUp

End If

'ActiveSheet.Protect Password:="MNPS"

End Sub

Die Buttons funktionieren auch alle, nur leider kommt oft eine Laufzeitfehlerneldung oder das ganze Programm hängt sich auf wenn ich erst mit dem einen Button eine Spalte eingefügt habe und im Anschluss mit dem anderen Button eine Spalte einfügen.

Es funktioniert also leider nicht verlässlich. Hat jemand eine Idee woran das liegen könnte?

Vielen Dank im Voraus!

...zur Frage

Kann mir jemand bei diesem Makro eine Schleife einbauen?

ich benötige dringend Hilfe bei diesem Makro!

ich habe dieses Makro von einem Mitglied von gf.

dieses Makro benötigt dringend eine Schleife

von Zeile 1 To 6000

also Zeile 1 ist SUMME(ZÄHLENWENN($A1:$F1;$L:$Q))

und Zeile 2 wäre dann $A2:$F2

und das Ganze dann bis Zeile 6000

Sub FormelAnpassen()

Dim spalte As Long

Dim zeile As Long

Dim bezugZeile As Long

zeile = 2

bezugZeile = 0

For spalte = 20 To 200

bezugZeile = bezugZeile + 1

Cells(zeile, spalte).FormulaArray = "=SUM(COUNTIF($A1:$F1,$L$" & bezugZeile & ":$Q$" & bezugZeile & "))"

End Sub

es wäre super wenn mir jemand helfen würde

danke im voraus

...zur Frage

VBA: Zwei Spalten mit Wert multiplizieren und dann addieren mit Hilfe von Makros

Hallöchen,

ich habe folgendes Problem Ich habe zwei Spalten die ich jeweils miteinander addieren möchte. Doch bevor ich diese addiere, möchte ich Spalte B mit dem Wert aus der TextBox1 multiplizieren und Spalte C mit dem Wert aus Textbox2. Danach sollen beide Spalten miteinander addiert und dann sortiert werden. Spalte D ist in diesem Fall die Ergebnisspalte. Das Programm hat auch schon funktioniert, jedoch habe ich vorher nur die spalten addiert und sortiert.

HIer mein bereits geschriebener Code:

Private Sub CommandButton1_Click()



' Prüfen ob Lastspitzen eingetragen wurden, ansonsten Fehlermeldung

        If TextBox1.Value = "" Or TextBox2.Value = "" Then
        MsgBox "Bitte geben Sie eine Lastspitze ein!"
     
Else
        
Dim wks As Excel.Worksheet
Dim lngLetzteZeile As Long
Dim Last1 As Integer
Dim Last2 As Integer
Last1 = TextBox1.Value
Last2 = TextBox2.Value  

Set wks = ActiveWorkbook.Worksheets("Vergleich")


With wks
 
lngLetzteZeile = .Cells(.Rows.Count, "B").End(xlUp).Row
If lngLetzteZeile < 15 Then Exit Sub

 With .Range("D15:D" & lngLetzteZeile)
 'berechne: D := B + C
 .FormulaR1C1 = "=RC[-2]*Last1+RC[-1]*Last2"
 'Formeln durch deren Ergebnis ersetzen
 .Value = .Value
 End With
 
With .Range("B15:D" & lngLetzteZeile)
 .Sort Key1:=.Cells(2), Order1:=xlDescending, _
 DataOption1:=xlSortTextAsNumbers, _
 SortMethod:=xlPinYin
End With

End With
End If


End Sub

...zur Frage

Excel VBA: Sverweis Formel - Makro einfügen!

Hi zusammen. Habe mir heute mein erstes Userform gebastelt (Google sei Dank...). Mein UF macht simpel nichts anderes, als Einträge aus der EIngabemaske in eine Tabelle zu füllen.

Dim emptyRow As Long

'Ermitteln der ersten leeren Zeile
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Wohin werden die eingegebenen Datein eingefüllt?
Cells(emptyRow, 1).Value = ComboBox1.Value
Cells(emptyRow, 5).Value = TextBox1.Value
Cells(emptyRow, 2).Value = TextBox2.Value
Cells(emptyRow, 3).Value = TextBox3.Value
Cells(emptyRow, 7).Value = TextBox4.Value

If OptionButton1.Value = True Then
    Cells(emptyRow, 6).Value = "1. Halbjahr"
End If

If OptionButton2.Value = True Then
    Cells(emptyRow, 6).Value = "2. Halbjahr"
End If


Me.Label7 = "Speichern erfolgreich!"

End Sub

Ich muss auch sagen, es funktioniert prächtig. Die Einträge werden alle korrekt erstellt etc. Nur habe ich in Spalte "H" meiner Tabelle, wo die Daten eingefügt werden, eine Spalte für SVerweis. Diese Formel soll jedesmal, wenn ein neuer Eintrag gespeichert wird, angefügt werden. Wenn ich von anfang an alle Formeln runterziehe bis ans Ende der Tabelle braucht Excel 2Minuten zum das Dokument zu öffnen... Formel lautet: =SVERWEIS($A2;'Tabelle1'!$A$1:$C$31;2;FALSCH) Wobei der Bezug A2 natürlich mit jeder Zeile anders ist (A2, A3, A4 etc.) Wenn ich die Formel "aufzeichne", erscheint folgendes, womit ich absolut nix anfangen kann.

Sub SVerweis_HC()
'
' SVerweis_HC Makro
'

'
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Tabelle1'!R[-1317]C[-7]:R[-1289]C[-6],2,FALSE)"
    Range("H1319").Select
End Sub

Kann hier wer helfen?

...zur Frage

Excel VBA: Bild einfügen, in Variable speichern, Größe ändern, ausrichten?

Ich habe jetzt unzähle Varianten durch. Ich baue ein Bestellsystem für zwei verschieden Shops. Heißt, bei jedem eingetragenen Artikel in die Bestellliste soll am Ende der Listen-Zeile das jeweilige Logo eingefügt werden, kleiner als das Originalbild, kleiner als die Zeile selbst, für die Übersichtlichkeit in der Liste, mittig ausgerichtet.

Ich habe von Pictures.Insert zu Shapes.AddPicture gewechselt, da ich gelesen habe, dass dies die korrektere Form sei. Jetzt bekomme ich eine Fehlermeldung bei der Festlegung eines Rahmens.
Kann mir jemand meine Fehler aufzeigen? Folgende Fragen stellen sich mir:
- Welchen Variablen-Typ brauche ich für ein eingefügtes Bild?
- Wie kann ich diese Variable dann verwenden, um Größe, Position und Rahmen festzulegen?

Danke sehr!!!!!!

Sub LogoEinfügen(Shop As String, Zeile As Integer, Spalte As Integer)

Dim Breite As Integer
Dim Höhe As Integer
Dim strDatei As String
Dim Logo As Object
Dim ShopFarbe As Long, Rot As Long, Blau As Long

' Farben für die zwei Shops festlegen
Rot = 26316
Blau = 13395456

' Dateinamen je nach Shop auswählen und Shop-Farbe einstellen
If Shop = "ZL" Then
  strDatei = "D:\logo1.jpg"
  ShopFarbe = Rot
End If

If Shop = "AQ" Then
  strDatei = "D:\logo2.jpg"
  ShopFarbe = Blau
End If

' Bild einfügen

' Ort festlegen
Dim rg As Range
Set rg = ActiveSheet.Cells(Zeile, Spalte)

' Und einfügen
Set Logo = ActiveSheet.Shapes.AddPicture(strDatei, msoTrue, msoTrue, rg.Left, rg.Top, -1, -1)
Set rg = Nothing

With Logo
      .LockAspectRatio = msoFalse              ' Verzerrung egal
      .Height = Rows(Zeile).RowHeight - 4      ' kleiner als Zeile
      .Width = Columns(Spalte).Width - 4       ' schmaler als Spalte
      .Top = Cells(Zeile, Spalte).Top + (Cells(Zeile, Spalte).Height - Logo.Height) / 2         ' mittig
      .Left = Cells(Zeile, Spalte).Left + (Cells(Zeile, Spalte).Width - Logo.Width) / 2          ' mittig
  End With
  
  ' Rahmen ums Bild, in der Farbe des Shops
  With Logo.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = ShopFarbe
    .Weight = 1.5
    .ForeColor.TintAndShade = 0
  .ForeColor.Brightness = 0
End With

Set Logo = Nothing

' Zeilenhöhe anpassen
' Rows(Zeile).RowHeight = Logo.Height
 
End Sub

...zur Frage

VBA MSG BOX Titel nur aufzählen wenn Spalte "L" bestimmter Text?

Hallo zusammen,

ich komme bei diesem Code nicht weiter. Die Msgbox soll nur die Zeilen auflisten wenn ihn Spalte "L" der Text "offen" vorkommt. Kann mir dabei jemand bitte behilflich sein?

Private Sub Workbook_Open()

Dim rDatWartung

Dim sMsgBaldFaellig As String

Dim sMsgUeberFaellig As String

sMsgBaldFaellig = ""

sMsgUeberFaellig = ""

lz = Cells(Rows.Count, 5).End(xlUp).Row

For Each rDatWartung In Range("D30:D600")

If rDatWartung.Value <> "" Then

If rDatWartung.Value <= Date + 7 Then

sMsgUeberFaellig = sMsgUeberFaellig & Cells(rDatWartung.Row, 4) & " " & vbCrLf & Cells(rDatWartung.Row, 6)

Else

If rDatWartung.Value <= Date + 14 Then _

sMsgBaldFaellig = sMsgBaldFaellig & Cells(rDatWartung.Row, 4) & " " & Cells(rDatWartung.Row, 4) & vbCrLf

End If

If sMsgUeberFaellig & sMsgBaldFaellig <> "" Then

MsgBox "Überfällig" & vbCrLf & " " & sMsgUeberFaellig

End If

End Sub

Herzlichen Dank, und einen schönen Abend

...zur Frage

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zur Frage

An Bedingungen gebundenes ausblenden von Zeilen?

Ich habe ein Problem, welches ich alleine nicht schaffe zu lösen.

Ich habe eine Exceltabelle mit einem Button "Closed ausblenden".
Bisher funktioniert es soweit, dass er alle in Spalte N "Closed" ausblendet.

Code ist bis jetzt so:

Private Sub ToggleButton4_Click()

If Me.ToggleButton4.Value = True Then

Dim Liste As Range

Dim lngCriteriaCount As Long

Dim arrCriteria() As String

Dim oLO As ListObject

Application.EnableEvents = True

For r = 3 To ActiveSheet.UsedRange.Rows.Count

If InStr(Cells(r, 14).Value, "CLOSED") Then

Rows(r).RowHeight = 0

End If

Next

Me.ToggleButton4.Caption = "'CLOSED' ausgeblendet"

Else

For l = 3 To ActiveSheet.UsedRange.Rows.Count

If InStr(Cells(l, 14).Value, "CLOSED") Then

Rows(l).RowHeight = 12

End If

Next

Me.ToggleButton4.Caption = "'closed' ausblenden"

End If

End Sub

Nun soll es erweitert werden:
Es soll nicht nur die Zeile sondern auch alle nachfolgenden Zeilen ausgeblendet werden - bis das Wort "Topic" oder "Topic ll" erreicht wird.

In diesem Beispiel also das gelb markierte mit ausblenden.

Kann mir jemand helfen?

...zur Frage

Hallo, ich möchte in einer Excel Datei per vba code bis zur ersten leeren zeile gehen, wie tue ich das?

ich möchte zur ersten leeren Zeile gehen und dann den rest markieren und löschen, also den kompletten Bereich ab da? BSp. A10 ist leer, dann möchte ich ab A10:z10 und abwärts alles markieren und löschen

Wie??

Sub FIND_EMPTY_CELL()

    Dim zeil As Integer
    Dim z As Integer
    Dim leerAbWo As Long

    zeil = ActiveSheet.UsedRange.Rows.Count 'letzte ausgefüllte Zeile

    For z = 8 To zeil

            If Cells(z, 1) = "" Then
                'leere Zelle gefunden
                leerAbWo = Cells(z, 1).Select 'gefundene Zelle selektieren
                'jetzt ab da an bis AA markieren und rest löschen!!!
                MsgBox leerAbWo
                Exit Sub
            End If
    Next z
End Sub

...zur Frage

Per Excel VBA eine Zeile mit einer Spalte vergleichen :) Hilfe :O

Ich versuche gerade ein Programm zu schreiben das eine Zeile mit einer Spalte vergleicht. Nun ic bin gerade noch am Anfang des Programmes und nicht sehr erfolgreich. Das Prizip ist es die Zeile (in Tabelle2) mit der Spalte(bzw. erstmal mit der Zelle(in Tabelle1)zu vergleichen). Die Zeile in Tabelle1 wird so gebildet das A und i zsm eine zeile angeben und i als Variable für die Forschleife dient. Das heißt das Programm geht Zeile für Zeile durch und sucht nach einer Zahlenübereinstimmung. Falls was gefunden wurde soll er erstmal per MsgBox ein Simples Test ausgeben damit ich weiß das es Funktioniert. Ich muss zugeben das ich VBA erst vor 3 Tagen angefangen habe zu Lernen. Dehalb seid nicht so Streng mit Fehlern zu mir :D ich hoffe ihr konnte mich helfen mfg Dennis :)

Sub CommandButton1_Click()

Dim i1 As Integer

i = 1

For i = 1 To 100

If Tabelle1.Cells(1 & i) = Tabelle2.Cells(1, 1) Then

MsgBox "Test"

End If

Next i

End Sub

...zur Frage

Wie berechne ich 30 min Mittelwerte in VBA?

Hallo Zusammen ,

ich bin leider wirklich nicht fit was das Thema Makro schreiben angeht deshalb habe ich folgendes Problem:

Ich habe mehrer Spalten mit etwa 1000 Zeilen voller Daten. Es handelt sich dabei um Minutenwerte. Diese würde ich gerne in 30 min Werte zusammenfassen. Da das händisch ewig dauert bräuchte ich dafür ein Makro welches den Mittelwert bildet und 3 Spalten weiter in der ersten Zeile (wo auch der erste Werte der zur Mittelwertsberechnung rangezogen wird notiert ist). Dann soll der nächste Mittelwert mit den Folgenden 29 Minuten-Werten gebildet werden, 3 Spalten weiter unter dem vorherigen Mittelwert notiert werden.

Folgendes habe ich versucht:

Sub Halbstundenmittelwerte()

Dim i As Integer

Dim z As Integer

Dim x As Integer

Dim MW As Double

For i = 10 To 15010 Step 30

z = i

x = z + 29

Range(Hz).Select

ActiveCell.FormulaR1C1 ="= AVERAGE("Cz:Cx")"

Range(Hi).Value = MW

Next i

End Sub

Danke euch !

...zur Frage

VBA Ausgewählte Zeilen kopieren und in anderer Tabelle einfügen (mit Variablen)?

Hallo Zusammen,

Ich hab ein Problem. Ich würde gern durch das schreiben einer 1 hinter meiner Materialsammlung per Knopfdruck alle gewählten Zeilen in eine Zusammengestellte Tabelle einfügen.

Die Materialsammlung bei der ich auswähle ist in Tabelle zwei und wird dann per Knopfdruck abgefragt. Die markierten sollen dann in Tabelle 1 in eine Tabelle eingefügt werden.

Da ich aber mit Variablen Arbeite ist das schwieriger als gedacht

Hier mein code zum verdeutlichen

Private Sub CommandButton1_Click()

Dim strBereich As Range Dim x As Integer

For x = 3 To 60 If Worksheets(2).Cells(x, 10) = "1" Then

Worksheets(1).Range(Cells(x, 2), Cells(x, 9))=Worksheets(2).Range(Cells(x, 1), Cells(x, 8))

End If Next x

End Sub

funktioniert leider aber nicht.

Bitte im Hilfe

...zur Frage

VBA Zellen verbinden mit schleife?

Hallo,

ich möchte mit Visual Basic in der Spalte A jeweils die 4 aufeinander folgenden Zellen miteinander verbinden. Also A4 - A7, A8 - A11 usw. In der Zeile mit range spuckt er einen Fehler und ich komme nicht drauf warum. Wäre super, wenn jemand mir helfen könnte 😁

Quellcode:

Option Explicit
Sub Merge()
Dim Counter1 As Integer
Dim Counter2 As Integer
Counter1 = 3
Counter2 = 7
Worksheets(„Tabelle1“).Activate
Do While Counter1 <= 1000
Range(Cells(Counter1,1), Cells(Counter2,1)).Select = True
Selection.Merge
Counter1 = Counter1 + 4
Counter2 = Counter2 + 4
Loop
End Sub

...zur Frage

VBA Code Erklärung

Guten Abend zusammen. Könnte mir jemand weiterhelfen bei diesem Code. Was macht er genau in Excel? Also Die einzelnen Schritte die er durchläuft,.

Option Explicit

Public Sub Double_Red()
Dim lngZeile As Long
Dim lngZeilenSprung As Long
Dim strSuchwert As String

lngZeile = Cells(Rows.Count, 4).End(xlUp).Row

  For lngZeilenSprung = lngZeile To 1 Step -1
    strSuchwert = Cells(lngZeilenSprung, 4).Value
      If Application.WorksheetFunction.CountIf(Range(Cells(1, 4), Cells(lngZeile, 4)), strSuchwert) <> 1 Then
        Cells(lngZeilenSprung, 4).Interior.ColorIndex = 3
      End If
  Next lngZeilenSprung

End Sub

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen