Microsoft Excel

Herbers Excel/VBA-Archiv

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

Werte in Spalte einfrieren, außer eine Zeile

Betrifft: Werte in Spalte einfrieren, außer eine Zeile von: Bonduca
Geschrieben am: 02.10.2014 10:11:26

Hallo zusammen,

ich habe eine Funktion, die super Spalten einfriert(Formeln durch Werte ersetzt). Wenn beispielsweise im "Datenblatt" der Monat "Januar" steht, wird in meiner Tabelle die Spalte "Januar" eingefroren.

Jetzt möchte ich aber weiterhin die jeweilige Spalte einfrieren, aber die Zeile 135 ausschließen. Es soll also alles, außer die Zeile 135 eingefroren werden.
Wie kann ich das noch einbauen?

Hier mein bisheriger Code:



Sub Datei_einfrieren()
Monat_einfrieren "Tabelle1", "Datenblatt" 
End Sub

'Im Datenblatt befindet sich das Monat, dass eigefroren werden soll
Function Monat_einfrieren(Ziel As String, Quelle As String)
   Dim lastrow As Long
   Dim Spalte As Long, lastColumn As Long
   Dim strMonat As String
      Dim wsZiel As Worksheet
    Set wsZiel = Worksheets(Ziel)
   strMonat = Worksheets(Quelle).Range("C33")
   With Worksheets(Ziel)
    If MsgBox("Daten für Monat """ & strMonat & """ in Tabelenblatt """ & .Name & """  _
einfrieren?", vbQuestion + vbOKCancel, "Monatsdaten einfrieren") = vbCancel Then Exit Function
       lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Monate in Zeile 9
       Application.ScreenUpdating = False
       For Spalte = 4 To lastColumn
         If Left(.Cells(1, Spalte), Len(strMonat)) = strMonat Then 'Monate in Zeile 9
           lastrow = .Cells(.Rows.Count, Spalte).End(xlUp).Row
           If lastrow > 4 Then
             With .Range(.Cells(10, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)) 'Zeile
               .Value = .Value
             End With
           End If
         End If
       Next
       Application.ScreenUpdating = True
   End With
 End Function


Danke!!

  

Betrifft: AW: Werte in Spalte einfrieren, außer eine Zeile von: Martin
Geschrieben am: 02.10.2014 10:20:49

Hallo Bonduca,

probiere es mal so, ist von mir aber ungestestet:

Function Monat_einfrieren(Ziel As String, Quelle As String)
    Dim lastrow As Long
    Dim Spalte As Long, lastColumn As Long
    Dim strMonat As String
    Dim varFormula As Variant
    Dim wsZiel As Worksheet
    Set wsZiel = Worksheets(Ziel)
    strMonat = Worksheets(Quelle).Range("C33")
    With Worksheets(Ziel)
        If MsgBox("Daten für Monat """ & strMonat & """ in Tabelenblatt """ & .Name & """  _
einfrieren?", vbQuestion + vbOKCancel, "Monatsdaten einfrieren") = vbCancel Then Exit Function
        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Monate in Zeile 9
        Application.ScreenUpdating = False
        
        For Spalte = 4 To lastColumn
            If Left(.Cells(1, Spalte), Len(strMonat)) = strMonat Then 'Monate in Zeile 9
                lastrow = .Cells(.Rows.Count, Spalte).End(xlUp).Row
                If lastrow > 4 Then
                    varFormula = .Cells(135, Spalte).Formula
                    With .Range(.Cells(10, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)) ' _
Zeile
                        .Value = .Value
                    End With
                    .Cells(137, Spalte).Formula = varFormula
                End If
            End If
        Next
        
        Application.ScreenUpdating = True
    End With
End Function
Viele Grüße

Martin


  

Betrifft: ...falsche Zeile von: Martin
Geschrieben am: 02.10.2014 10:26:43

Sorry, ich hatte deine Formel versehentlich in Zeile 137 verschoben. So sollte es richtig sein:

Function Monat_einfrieren(Ziel As String, Quelle As String)
    Dim lastrow As Long
    Dim Spalte As Long, lastColumn As Long
    Dim strMonat As String
    Dim varFormula As Variant
    Dim wsZiel As Worksheet
    Set wsZiel = Worksheets(Ziel)
    strMonat = Worksheets(Quelle).Range("C33")
    With Worksheets(Ziel)
        If MsgBox("Daten für Monat """ & strMonat & """ in Tabelenblatt """ & .Name & """  _
einfrieren?", vbQuestion + vbOKCancel, "Monatsdaten einfrieren") = vbCancel Then Exit Function
        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Monate in Zeile 9
        Application.ScreenUpdating = False
        
        For Spalte = 4 To lastColumn
            If Left(.Cells(1, Spalte), Len(strMonat)) = strMonat Then 'Monate in Zeile 9
                lastrow = .Cells(.Rows.Count, Spalte).End(xlUp).Row
                If lastrow > 4 Then
                    varFormula = .Cells(135, Spalte).Formula
                    With .Range(.Cells(10, Spalte), .Cells(.Rows.Count, Spalte).End(xlUp)) ' _
Zeile
                        .Value = .Value
                    End With
                    .Cells(135, Spalte).Formula = varFormula
                End If
            End If
        Next
        
        Application.ScreenUpdating = True
    End With
End Function



  

Betrifft: KEINE ANTWORT??? - Dann scheint alles zu gehen owT von: Martin
Geschrieben am: 02.10.2014 14:04:42




  

Betrifft: SUPER!!!! von: Bonduca
Geschrieben am: 02.10.2014 14:56:56

Super!!
Vielen, vielen Dank!
Konnte es leider nicht eher testen, da ich weg musste!
Es läuft einwandfrei!


  

Betrifft: AW: SUPER!!!! von: Martin
Geschrieben am: 02.10.2014 16:54:03

okay, freut mich!


 

Beiträge aus den Excel-Beispielen zum Thema "Werte in Spalte einfrieren, außer eine Zeile"