Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.06.2025 22:11:12
24.06.2025 21:29:43
24.06.2025 19:48:50
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Werte in Spalte einfrieren, außer eine Zeile

Werte in Spalte einfrieren, außer eine Zeile
02.10.2014 10:11:26
Bonduca
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!!

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte in Spalte einfrieren, außer eine Zeile
02.10.2014 10:20:49
Martin
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

Anzeige
...falsche Zeile
02.10.2014 10:26:43
Martin
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

Anzeige
KEINE ANTWORT? - Dann scheint alles zu gehen owT
02.10.2014 14:04:42
Martin

SUPER!!!!
02.10.2014 14:56:56
Bonduca
Super!!
Vielen, vielen Dank!
Konnte es leider nicht eher testen, da ich weg musste!
Es läuft einwandfrei!

AW: SUPER!!!!
02.10.2014 16:54:03
Martin
okay, freut mich!
Anzeige

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige