Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Schleife: markierte Werte übertragen

Betrifft: Schleife: markierte Werte übertragen von: stormlamp
Geschrieben am: 29.09.2014 20:38:51

Hallo Zusammen,

in der Musterdatei: https://www.herber.de/bbs/user/92888.xlsx

sind in Tabelle1 in Zeile 3 in den Spalten von B bis J mögliche Steuerungswerte.

Nun benötige ich eine Schleife, die in Tabelle1 Zeile 6 prüft, ob die Zelle unterhalb eines Steuerungswerts (Zeile 3) irgendwie gefüllt ist (hier x,y,z).

Wenn ja, soll der darüberstehende Steuerungswert aus Zeile 3 in Tabelle 2 Zelle B2 übertragen werden. Anschließend soll eine Subroutine mit einem Call aufgerufen werden, die weitere Berechnungen durchführt.

Anschließend soll der nächste Wert in der Schleife genommen werden, bis alle Spalten B bis J der Tabelle 1 abgearbeitet sind.

Kann mir da bitte einer bei helfen.

Gruß Hans

  

Betrifft: AW: Schleife: markierte Werte übertragen von: fcs
Geschrieben am: 30.09.2014 13:20:51

Hallo Hans,

funktioniert etwa wie folgt.

Gruß
Franz

Sub Machwas()
  Dim wksCode As Worksheet, wksWert As Worksheet
  Dim ZelleCode As Range, varKodierung
  
  Set wksCode = Worksheets("Tabelle1")
  Set wksWert = Worksheets("Tabelle2")
  
  With wksCode
    For Each ZelleCode In .Range("B6:J6").Cells
      If ZelleCode.Value <> "" Then
        varKodierung = .Cells(3, ZelleCode.Column).Value
        wksWert.Range("B2") = varKodierung
        Call prcBerechnung
      End If
    Next
  End With
End Sub

Sub prcBerechnung()
  'nun Berechne mal
  MsgBox "Kodierung: " & Worksheets("Tabelle2").Range("B2") 'testzeile
End Sub



  

Betrifft: Gelöst:: Schleife: markierte Werte übertragen von: stormlamp
Geschrieben am: 30.09.2014 19:32:09

Hallo Franz,

vielen vielen Dank. Dein Code funktioniert perfekt!

Das spart mir sehr viel Handarbeit.

Freundliche Früße
Hans


 

Beiträge aus den Excel-Beispielen zum Thema "Schleife: markierte Werte übertragen"