Zellen schreiben mit Bedingung

Question

Hallo zusammen,

ich bin mit VBA nicht sehr gut Bewandert. Ich habe vor einiger Zeit eine Tabelle erstellt für die Dienstplangestaltung. Die Tabelle kopiert mittels Makro bestimmte Zellinhalte aus dem Übersichtsdatenblatt in einzelne Datenblätter. Das geschieht mittels eines neuen Symbols in der Symbolleiste. Nun muss ich das ganze Programm verändern aus tariflichen Gründen. In diesem Zuge möchte ich den Gruppenleitern die Arbeit erleichtern in dem beim Kopieren vorher in den Zellen D,I,O,T,Z,AE,AK,AP,AV,BA,BG,BL jeweils der Bereich zwischen Zeile 6-37 geschaut werden, ob ein Wert drinn ist. Wenn das der Fall ist, dann soll in die jweils danebenliegende Zelle (rechts) ein - eingefügt werden. Ich habe nun schon alles Mögliche und allen möglichen Code aus dem Internet probiert aber das klappt alles nicht so wie es soll.


Grüße Jumpanino

Answer 1

Hallo Jumpanino,

wir sehen weder Deine Datei, noch Dein Makro, somit ist Aussicht auf Hilfe gleich Null.

Gruss
Rainer

Answer 2

Hallo,

ich Poste mal mein Makro.

Sub Daten_kopieren()

Dim Spalte As Integer, Gemerkte_Spalte As Integer, Zeile As Long, Spalte_auslassen As String

'=======================================================================================
'Bildschirmaktualisierung ausschalten. Unterbindet, dass der Bildschirm während der
'Abarbeitung des Makros nicht jeden Schritt zeigt und somit flimmert.
'=======================================================================================
Application.ScreenUpdating = False

'=======================================================================================
'Schleife zum Ermitteln, welche Zeile in dem Bereich C6:BO36, die letzte beschriebene
'Zeile ist. Dabei werden die Spalten M, X, AI, AT, BE und BP nicht berücksichtigt, da
'diese Formeln enthalten
'=======================================================================================
Spalte_auslassen = ",13,24,35,46,57,68,"
For Spalte = 3 To 69
If InStr(1, Spalte_auslassen, "," & CStr(Spalte) & ",") = 0 Then
If Zeile < Cells(38, Spalte).End(xlUp).Row + 1 Then
Zeile = Cells(38, Spalte).End(xlUp).Row
Gemerkte_Spalte = Spalte
End If
End If
Next
'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis01" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis01").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 3), Cells(Zeile, 13)).Copy
Worksheets("AZ-Nachweis01").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis02" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis02").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 14), Cells(Zeile, 24)).Copy
Worksheets("AZ-Nachweis02").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis03" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis03").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 25), Cells(Zeile, 35)).Copy
Worksheets("AZ-Nachweis03").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis04" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis04").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 36), Cells(Zeile, 46)).Copy
Worksheets("AZ-Nachweis04").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis05" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis05").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 47), Cells(Zeile, 57)).Copy
Worksheets("AZ-Nachweis05").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis06" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis06").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 58), Cells(Zeile, 68)).Copy
Worksheets("AZ-Nachweis06").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub



Gruß Jumpanino

Answer 3

Hallo Jumpanino,

bitte lade Deine Datei mal unter http://www.file-upload.net/ hoch und teile uns den Link, den Du erhältst, hier mit. Denn hier wird keiner Lust haben eine Datei nachzubauen, die ähnlich Deiner ist, wenn Du bereits eine fertige Datei hast.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 4

Hallo,

hach das ist ja Lustig. Genau du hast mir damals das Makro geschrieben. Das ist nun schon glaub sechs Jahre her.

Also hier der Link für die Datei: www.file-upload.net/download-2331846/Test-01.l-schen-der-sa-spalte.xls.html


Gruß Jumpanino

Answer 5

Hallo Jumpanino,

nachfolgendes Makro sollte das relaisieren, was Du Dir vorgestellt hast.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Prüfen()
Dim intRow As Integer
Dim intColumn As Integer
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For intColumn = 4 To 59 Step 11
For intRow = 6 To 37
If Cells(intRow, intColumn) > "" Then _
Cells(intRow, intColumn).Offset(0, 1) = "-"

Next intRow
Next intColumn

For intColumn = 9 To 64 Step 11
For intRow = 6 To 37
If Cells(intRow, intColumn) > "" Then _
Cells(intRow, intColumn).Offset(0, 1) = "-"

Next intRow
Next intColumn
ERRORHANDLER:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 6

Hallo coros,

super, das funktioniert einwandfrei. So habe ich mir das gedacht. Vielen vielen Dank.

Grüße Jumpanino

Answer 7

Hallo Jumpanino,

gerne geschehen. Freut mich, dass alles funktioniert. Danke auch für die Rückmeldung.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 8

Hallo coros,

vielleicht kannst du mir ja noch mal helfen oder jemand anderes und zwar in der Spalte E soll eigendlich über Gültigkeit eine dropdownliste hinn. Das geht auch soweit. nur ist die Spalte sehr schmal. Damit verbunden das Problem, dass ich in der Dropdownliste nichts sehe. Ich kann die aber nicht einfach vergrößern. Bzw. ich weiss nicht wie. Die Suche ergab nur, dass ich eine Cobobox erstellen soll, nur davon habe ich gar keine Ahnung.

Grüße Jumpanino

Answer 9

Hallo Jumpanino,

sorry, aber nicht ganz verständlich. Mit Deiner eigentlichen Frage wolltest Du, dass unter Anderem in Spalte E ein Bindestrich eingefügt werden soll. Nun soll dort ein Gültigkeitsfeld hin. Was soll denn dort auf Gültigkeit geprüft werden?
Du musst Dir mal angewöhnen etwas mehr von dem zu schreiben, was Du eigentlich erreichen möchtest. Denn das hier ist ein Forum in dem es um PC, SOftware usw. geht aber nicht um Hellsehen.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 10

Hallo coros,

Ok, ich werde mich hoffentlich bessern.
Also in die Spalte C kommt die Uhrzeit Stunde, in die Spalte D die Uhrzeit Minute. In Spalte F und G wieder Stunde und Minute. Also eben Arbeit von - bis. In Spalte E kommt in der Regel, wenn eben eine Uhrzeit eingetragen ist, der Bindestrich. Das ist aber auch die Spalte, in der "gekennzeichnette Arbeitszeit" rein kommt. Bedeutet: Hier schreibt man dann Urlaub, Schule, Krank, Fortbildung usw. rein und die Spalte M rechnet dann entsprechend. Also wenn eine Uhrzeit von bis eingetragen ist, dann eben die Stundenanzahl und wenn aber in Spalte E was drin steht, dann eben entsprechend der Bezeichnung. Jetzt ist es aber so, dass in Spalte E das ja exakt so geschrieben stehen muss, wie die Spalte M das dann auch überprüft. Also z.B. haben wir "ZS (§ 27)". wenn nun der Dienstplanersteller hier bei der eingabe ein Leerzeichen nicht macht oder was anderes, dann rechnet mir die Spalte M ja nix. Das wollte ich mit der Möglichkeit einer Gültigkeit mit Dropdown-Menü. Nur eben, das is eine seeehr kleine Spalte und das Dropdownmenü ist dann gänzlich unbrauchbar, da auch noch ein Scrollbalken so ziemlich alles verdeckt. Daher wollte ich einfach das Dropdownmenü vergrößern, wenn man auf eine Zelle in Spalte E klickt aber das geht wohl nicht. Daher suche ich nun nach einer anderen Lösung.


Grüße Jumpanino