Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1368to1372
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

1. Spalte auf Wert prüfen, 2. Spalte Wert v. oben

1. Spalte auf Wert prüfen, 2. Spalte Wert v. oben
18.07.2014 15:10:54
gavri
Hallo zusammen,
meine Kenntnisse von VBA beziehen sich auf "Suche im Internet und kopieren in das Modul". Also habt mit mir etwas Rücksicht :-)
Leider habe ich hierzu nichts passendes gefunden:
Ich möchte das in den Spalte B3:B50000 geprüft wird, ob dort ein Wert steht (Eurobetrag). Wenn ja soll in der gleichen Zeile/Spalte F der Wert von oben kopiert werden.
Dann habe ich noch eine 2te Tabelle in dieser soll genauso wie oben geprüft werden, ob in Spalte B ein Wert steht. Wenn ja, dann soll geprüft werden, ob in Spalte C ein Betrag steht (Währung). Wenn ja, dann soll in Spalte E der Wert B minus den Wert C eingetragen werden. Ist Spalte C leer, dann soll geprüft werden, ob in Spalte D ein Wert steht (hierbei handelt es sich um ein Prozentwert), Wenn ja, dann soll in Spalte E der Wert aus Spalte B minus den Wert in Prozent aus Spalte D. Ist Spalte C und D leer, dann soll er nur den Wert aus B übernehmen.
Vielen Dank für die Unterstützung.
MFG
Gavri

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Musterdatei?
18.07.2014 15:29:57
UweD
Hallo
du hast bessere Chancen eine Lösung zu bekommen, wenn du eine (anonymisierte) Musterdatei hochlädst...

1. Spalte auf Wert prüfen, 2. Spalte Wert v. oben
18.07.2014 18:09:22
gavri
Ergänzung zur Spalte F:
Wenn ein Wert in der Spalte F steht soll natürlich nicht der Wert von oben kopiert werden.

AW: 1. Spalte auf Wert prüfen, 2. Spalte Wert v. oben
19.07.2014 13:00:56
UweD
Hallo
hier die beiden Makros
Option Explicit
Sub TeilA()
On Error GoTo Fehler
Dim TB, i%
Dim ZE&, LR&
Dim stCalc%
'*** bescheunigt das Makro
With Application
.ScreenUpdating = False
stCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set TB = Sheets(1)
ZE = 2 'ab Zeile
With TB
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile der Spalte 2=B
For i = ZE To LR
If .Cells(i, 2)  "" Then
If .Cells(i, 6) = "" Then
.Cells(i, 6) = .Cells(i - 1, 6)
End If
End If
Next
End With
'*** Fehlerbehandlung
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
'*** Rücksetzen
With Application
.ScreenUpdating = True
If .Calculation  stCalc Then .Calculation = stCalc
End With
End Sub
Sub TeilB()
On Error GoTo Fehler
Dim TB, i%
Dim ZE&, LR&
Dim stCalc%
'*** bescheunigt das Makro
With Application
.ScreenUpdating = False
stCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set TB = Sheets(2)
ZE = 2 'ab Zeile
With TB
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile der Spalte 2=B
For i = ZE To LR
If .Cells(i, 2)  "" Then
If .Cells(i, 9) = "" Then 'Rechnung kopieren
.Cells(i, 9) = .Cells(i - 1, 9)
End If
If .Cells(i, 3)  "" Then 'Rabatt Betrag
.Cells(i, 5) = .Cells(i, 2) - .Cells(i, 3)
ElseIf .Cells(i, 4)  "" Then 'Rabatt Prozent
.Cells(i, 5) = .Cells(i, 2) * (1 - .Cells(i, 4))
Else ' weder noch
.Cells(i, 5) = .Cells(i, 2)
End If
End If
Next
End With
'*** Fehlerbehandlung
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
'*** Rücksetzen
With Application
.ScreenUpdating = True
If .Calculation  stCalc Then .Calculation = stCalc
End With
End Sub

Gruß UweD

Anzeige
AW: 1. Spalte auf Wert prüfen, 2. Spalte Wert
21.07.2014 08:26:52
gavri
Guten Morgen Uwe,
vielen Dank. Ich werde es nachher ausprobieren und dann Rückmeldung geben.
Gruß
Gavri

AW: 1. Spalte auf Wert prüfen, 2. Spalte Wert
21.07.2014 16:08:42
gavri
Hallo Uwe,
es funktioniert alles wunderbar. nochmals vielen Dank.
Gruß
Gavri

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige