Anzeige
Archiv - Navigation
1132to1136
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

Makro mit .Find und wenn

Makro mit .Find und wenn
meixner
Hallo zusammen,
habe ein Problem mit unterem Makro. Über eine Inputbox gebe ich eine ISIN Aktie ein in Datenblatt 1.
Anhand dieser ISIN sucht das Makro alle ISINs aus Datenblatt 2 in Spalte D raus und trägt sie wieder in Datenblatt 1 ein.
Mein Problem:
Ich gebe in die Inputbox die ISIN ein, dann sucht das Makro diese ISIN in Datenblatt 2 und trägt diese in Datenblatt 1 nur wenn in Spalte A eine 1 steht. Wie kann ich so eine Wenn - Fkt. einbauen in diesem Makro?
Anbei unten ein Teil des Makros.
Vielen Dank für Tips.
Dani
Sub Dividendenreinvestment()
Dim strRIC As String, rngSuch As Range 'Variablen deklarieren
Dim rngF As Range, lngZ As Long, lngErst As Long
' ----------------------------------------------------------------------- neu Anfang
Dim specialdividend As Double
Dim AS_Geschäft As Range
' ----------------------------------------------------------------------- neu Ende
Dim rngRange As Range
Dim ZeileStart As Long
' RIC wird gesucht in AlleBestände_alleFonds in Spalte C;
' Eingabe von RIC für das erste Bezugsrecht in A35, C8
ISIN = InputBox("Bitte ISIN Aktie eingeben:", "Dateneingabe:")
If ISIN = vbNullString Then Exit Sub
specialdividend = Application.InputBox("Bitte Betrag der special Dividend " & _
"oder Capital Return eingeben:", "Dateneingabe:", , , , , , 1)
If specialdividend = False Then Exit Sub
'Jedesmal wenn der in der Inputbox eingegebene ISIN in Datenblatt 'AlleBeständealleFonds' Spalte D gefunden wird, wird der RIC in Datenblatt 'Kapmaßnahme' Spalte C eingetragen
With Workbooks("Template_alle_Kapitalmaßnahmen.xls")
Set rngSuch = .Worksheets(2).Columns(4)
Set rngF = rngSuch.Find(What:=ISIN, LookAt:=xlPart)
If Not rngF Is Nothing Then
lngErst = rngF.Row
With .Worksheets(1)
lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row 'letzte in Sp.D belegte Zeile
ZeileStart = lngZ + 1
Do
'Sheets(5).Range("B5").Value = strRIC
lngZ = lngZ + 1 ' nächste (leere) Zeile
.Cells(lngZ, 1) = rngF.Offset(0, -3) ' a
.Cells(lngZ, 2) = rngF.Offset(0, -2) ' b
.Cells(lngZ, 3) = rngF.Offset(0, -1) ' C
.Cells(lngZ, 4) = ISIN ' d
' d
.Cells(lngZ, 5) = rngF.Offset(0, 1) ' e
.Cells(lngZ, 6) = rngF.Offset(0, 2) ' f
.Cells(lngZ, 17) = rngF.Offset(0, 6) ' Q
.Cells(lngZ, 12) = rngF.Offset(0, 4) ' L
.Cells(lngZ, 20) = rngF.Offset(0, 12).FormulaR1C1 ' T
.Cells(lngZ, 18) = rngF.Offset(0, 11).FormulaR1C1 ' R
' .Cells(lngZ, 29) = rngF.Offset(0, 17)

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
?
01.02.2010 17:51:45
Ramses
Hallo
".,.Wie kann ich so eine Wenn - Fkt. einbauen in diesem Makro..."
Sorry,... ich versteh kein Wort. WELCHE WENN-Funktion willst du denn ?
Gruss Rainer
kann mir jmd. helfen?
02.02.2010 10:31:03
meixner
Hallo zusammen!
kann mir da jmd. helfen?
über die Inputbox gebe ich eine ISIN ein. Das Makro sucht über .find in sheet(2) Spalte D nach dieser ISIN und schreibt die gefundene ISIN und noch weitere Daten wieder in Sheet(1) rein. Das Makro soll JETZT nach ISIN in sheet 2 spalte D und nach fondsnummer, DIE IMMER 1 IST (Spalte A). Erst wenn das Makro die ISIN in Spalte D gefunden hat und wenn die Fondsnummer in Spalte A 1 ist, erst dann sollen die gefundenen Infos in Sheet 1 eingetragen werden!
Das untere Makro sucht aktuell die ISIN für alle Fonds und nicht nur für Fonds mit der Fondsnummer 1.
Ich brauche eine Differenzierung in Form einer Wenn - Fkt. vielleicht?
Unten anbei das Makro.
Viele Grüße und vielen Dank.
Dani
Sub Reinvestments()
Dim strRIC As String, rngSuch As Range 'Variablen deklarieren
Dim rngF As Range, lngZ As Long, lngErst As Long
' ----------------------------------------------------------------------- neu Anfang
Dim specialdividend As Double
Dim AS_Geschäft As Range
Dim Fondsnummer As Long
' ----------------------------------------------------------------------- neu Ende
Dim rngRange As Range
Dim ZeileStart As Long
' RIC wird gesucht in AlleBestände_alleFonds in Spalte C;
' Eingabe von RIC für das erste Bezugsrecht in A35, C8
ISIN = InputBox("Bitte ISIN Aktie eingeben:", "Dateneingabe:")
If ISIN = vbNullString Then Exit Sub
specialdividend = Application.InputBox("Bitte Betrag der special Dividend " & _
"oder Capital Return eingeben:", "Dateneingabe:", , , , , , 1)
If specialdividend = False Then Exit Sub
'Jedesmal wenn der in der Inputbox eingegebene ISIN in Datenblatt 'AlleBeständealleFonds' Spalte D gefunden wird, wird der RIC in Datenblatt 'Kapmaßnahme' Spalte C eingetragen
With Workbooks("Template_alle_Kapitalmaßnahmen.xls")
Set rngSuch = .Worksheets(2).Columns(4)
Set rngF = rngSuch.Find(What:=ISIN, LookAt:=xlPart)
' Set rngSuch = .Worksheets(2).Columns(1)
' Set rngF = rngSuch.Find(What:=Fondsnummer, LookAt:=xlPart)
If Not rngF Is Nothing Then
lngErst = rngF.Row
With .Worksheets(1)
lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row 'letzte in Sp.D belegte Zeile
ZeileStart = lngZ + 1
Do
'Sheets(5).Range("B5").Value = strRIC
lngZ = lngZ + 1 ' nächste (leere) Zeile
.Cells(lngZ, 1) = rngF.Offset(0, -3) ' a
.Cells(lngZ, 2) = rngF.Offset(0, -2) ' b
.Cells(lngZ, 3) = rngF.Offset(0, -1) ' C
.Cells(lngZ, 4) = ISIN ' d
' d
.Cells(lngZ, 5) = rngF.Offset(0, 1) ' e
.Cells(lngZ, 6) = rngF.Offset(0, 2) ' f
.Cells(lngZ, 17) = rngF.Offset(0, 6) ' Q
.Cells(lngZ, 12) = rngF.Offset(0, 4) ' L
.Cells(lngZ, 20) = rngF.Offset(0, 12).FormulaR1C1 ' T
.Cells(lngZ, 18) = rngF.Offset(0, 11).FormulaR1C1 ' R
' .Cells(lngZ, 29) = rngF.Offset(0, 17) ' Spalte AC in Kapmaßnahme und Spalte U (Round Lot)in Datenblatt AlleBestände_alleFonds
' ----------------------------------------------------------------------- neu Anfang
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 21) = specialdividend ' schreibe in Spalte U
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 13) = Sheets("Parameter").Range("q8").FormulaR1C1 ' schreibe in Spalte U
' Formel für die Berechnung des EX - Prices wird in Spalte AB in Datenblatt "KapMaßnahme" kopiert
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 28) = Sheets("Parameter").Range("b22").FormulaR1C1
Anzeige
AW: kann mir jmd. helfen?
02.02.2010 10:48:12
Ramses
Hallo
Der Einfachheit halber einfach mal so
-----------------------------
If Not rngF Is Nothing Then
lngErst = rngF.Row
If .cells(lngErst,1)=1 Then
With .Worksheets(1)
lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row 'letzte in Sp.D belegte Zeile
ZeileStart = lngZ + 1
End If
Do
---------------
Aber ehrlich gesagt, verstehe ich nicht was die Schleife dort überhaupt soll
Gruss Rainer
AW: kann mir jmd. helfen?
02.02.2010 11:01:01
meixner
Danke für die Hilfe, aber es klappt nicht.
Bekomme die Fehlermeldung Fehler beim kompilieren: End if ohne if - Block. Hast Du noch einen Tip?
Viele Grüße
Dani.
Anzeige
Hilfe!!!!!!!!
02.02.2010 11:52:55
meixner
Hallo zusammen!
hat jmd. noch einen Tip bzgl. dem unteren Makro?
Viele Grüße
Dani
AW: kann mir jmd. helfen?
02.02.2010 11:56:55
Ramses
Hallo
Da ich nur deinen Code kopiert habe, müsste der Fehler auch schon vorher aufgetreten sein.
Das liegt nicht an meiner Anpassung und ist eine missverständliche Meldung von EXCEL
Es fehlt kein "End If" sondern ein "End With"
If .cells(lngErst,1)=1 Then
With .Worksheets(1)
lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row 'letzte in Sp.D belegte Zeile
ZeileStart = lngZ + 1
End With
End If
Gruss Rainer
AW: kann mir jmd. helfen?
02.02.2010 12:37:01
meixner
Hallo Rainer,
vorher habe ich keine Fehlermeldung bekommen.
Jetzt bekomme ich eine andere Fehlermeldung: Fehler beim kompilieren: Else ohne If.
Unten anbei das ganze Makro und nicht nur ein Teil des Makros. Kapiere nicht wo das Problem liegt?
Viele Grüße
Dani
Sub reinvestment()
Dim strRIC As String, rngSuch As Range                         'Variablen deklarieren
Dim rngF As Range, lngZ As Long, lngErst As Long
' ----------------------------------------------------------------------- neu Anfang
Dim specialdividend As Double
Dim AS_Geschäft As Range
Dim Fondsnummer As Long
' ----------------------------------------------------------------------- neu Ende
Dim rngRange As Range
Dim ZeileStart As Long
' RIC wird gesucht in AlleBestände_alleFonds in Spalte C;
' Eingabe von RIC für das erste Bezugsrecht in A35, C8
ISIN = InputBox("Bitte ISIN Aktie eingeben:", "Dateneingabe:")
If ISIN = vbNullString Then Exit Sub
specialdividend = Application.InputBox("Bitte Betrag der special Dividend " & _
"oder Capital Return eingeben:", "Dateneingabe:", , , , , , 1)
If specialdividend = False Then Exit Sub
'Jedesmal wenn der in der Inputbox eingegebene ISIN in Datenblatt 'AlleBeständealleFonds'  _
Spalte D gefunden wird, wird der RIC in Datenblatt 'Kapmaßnahme' Spalte C eingetragen
With Workbooks("Template_alle_Kapitalmaßnahmen.xls")
Set rngSuch = .Worksheets(2).Columns(4)
Set rngF = rngSuch.Find(What:=ISIN, LookAt:=xlPart)
' Set rngSuch = .Worksheets(2).Columns(1)
' Set rngF = rngSuch.Find(What:=Fondsnummer, LookAt:=xlPart)
If .Cells(lngErst, 1) = 1 Then
With .Worksheets(1)
lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row 'letzte in Sp.D belegte Zeile
ZeileStart = lngZ + 1
End With
End If
Do
'Sheets(5).Range("B5").Value = strRIC
lngZ = lngZ + 1            ' nächste (leere) Zeile
.Cells(lngZ, 1) = rngF.Offset(0, -3)               ' a
.Cells(lngZ, 2) = rngF.Offset(0, -2)               ' b
.Cells(lngZ, 3) = rngF.Offset(0, -1)                       ' C
.Cells(lngZ, 4) = ISIN                              ' d
' d
.Cells(lngZ, 5) = rngF.Offset(0, 1)                ' e
.Cells(lngZ, 6) = rngF.Offset(0, 2)                ' f
.Cells(lngZ, 17) = rngF.Offset(0, 6)               ' Q
.Cells(lngZ, 12) = rngF.Offset(0, 4)               ' L
.Cells(lngZ, 20) = rngF.Offset(0, 12).FormulaR1C1  ' T
.Cells(lngZ, 18) = rngF.Offset(0, 11).FormulaR1C1  ' R
'  .Cells(lngZ, 29) = rngF.Offset(0, 17)  ' Spalte AC in Kapmaßnahme und Spalte  _
U (Round Lot)in Datenblatt AlleBestände_alleFonds
' ----------------------------------------------------------------------- neu Anfang
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 21) = specialdividend  ' schreibe in Spalte U
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 13) = Sheets("Parameter").Range("q8").FormulaR1C1  ' schreibe  _
in Spalte U
' Formel für die Berechnung des EX - Prices wird in Spalte AB in  _
Datenblatt "KapMaßnahme" kopiert
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 28) = Sheets("Parameter").Range("b22").FormulaR1C1
'If .Cells(lngZ, 1) = 1 And .Cells(lngZ, 4) = ISIN Then _
'Selection.Delete shift:=xlDown
' ----------------------------------------------------------------------- neu Ende
Set rngF = rngSuch.FindNext(rngF)
Loop While Not rngF Is Nothing And rngF.Row  lngErst
End With
Else
MsgBox "Die Aktie ist nicht vorhanden bzw. die Eingabe wurde abgebrochen!", _
vbCritical, "Nur Zahlen eingeben!"
End If
End With
For Each Zelle In Range("F8:F40")
last_trade_Aktie = Sheets("Parameter").Range("b3").FormulaR1C1
If Zelle  "" Then Zelle.Offset(0, 1) = last_trade_Aktie
Next Zelle
With Worksheets(1)                                                  '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 21), .Cells(lngZ, 21)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
With Worksheets(1)                                                  '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 13), .Cells(lngZ, 16)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
'es wird in leere Zeele in Spalte 28 (Ex - Price) gesucht und Formel aus vorheriger Zelle in  _
gefundene leere Zelle kopiert
With Worksheets(1)                                                  '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 28), .Cells(lngZ, 28)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
With Worksheets(1)                                                  '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 29), .Cells(lngZ, 29)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
With Worksheets(1)                                                  '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 26), .Cells(lngZ, 26)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
'If Sheets(1).Range("a8:a10") = 1 And Sheets(1).Range("D8:D10") = ISIN Then Selection.Delete  _
shift:=xlUp
'Range("B17").Select
'ActiveCell.FormulaR1C1 = "=IF(R[-9]C[-1]=1,)"
'Range("B18").Select
End Sub

Anzeige
AW: kann mir jmd. helfen?
02.02.2010 13:04:11
Ramses
Hallo
Ich hab mal versucht das ganze in eine lesbare Form zu bringen
Sub reinvestment()
    Dim strRIC As String, rngSuch As Range 'Variablen deklarieren
    Dim rngF As Range, lngZ As Long, lngErst As Long
    ' ----------------------------------------------------------------------- neu Anfang
    Dim specialdividend As Double
    Dim AS_Geschäft As Range
    Dim Fondsnummer As Long
    ' ----------------------------------------------------------------------- neu Ende
    Dim rngRange As Range
    Dim ZeileStart As Long
    
    ' RIC wird gesucht in AlleBestände_alleFonds in Spalte C;
    ' Eingabe von RIC für das erste Bezugsrecht in A35, C8
    ISIN = InputBox("Bitte ISIN Aktie eingeben:", "Dateneingabe:")
    If ISIN = vbNullString Then Exit Sub
    
    specialdividend = Application.InputBox("Bitte Betrag der special Dividend oder Capital Return eingeben:", "Dateneingabe:", , , , , , 1)
    If specialdividend = False Then Exit Sub
    
    'Jedesmal wenn der in der Inputbox eingegebene ISIN in Datenblatt
    'AlleBeständealleFonds Spalte D gefunden wird, wird der RIC in Datenblatt 'Kapmaßnahme' Spalte C eingetragen
    With Workbooks("Template_alle_Kapitalmaßnahmen.xls")
        Set rngSuch = .Worksheets(2).Columns(4)
        Set rngF = rngSuch.Find(What:=ISIN, LookAt:=xlPart)
        ' Set rngSuch = .Worksheets(2).Columns(1)
        ' Set rngF = rngSuch.Find(What:=Fondsnummer, LookAt:=xlPart
        If .Cells(lngErst, 1) = 1 Then
            With .Worksheets(1)
                lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row 'letzte in Sp.D belegte Zeile
                ZeileStart = lngZ + 1
            End With
        End If
        Do
            'Sheets(5).Range("B5").Value = strRIC
            lngZ = lngZ + 1 ' nächste (leere) Zeile
            .Cells(lngZ, 1) = rngF.Offset(0, -3) ' a
            .Cells(lngZ, 2) = rngF.Offset(0, -2) ' b
            .Cells(lngZ, 3) = rngF.Offset(0, -1) ' C
            .Cells(lngZ, 4) = ISIN ' d
            .Cells(lngZ, 5) = rngF.Offset(0, 1) ' e
            .Cells(lngZ, 6) = rngF.Offset(0, 2) ' f
            .Cells(lngZ, 17) = rngF.Offset(0, 6) ' Q
            .Cells(lngZ, 12) = rngF.Offset(0, 4) ' L
            .Cells(lngZ, 20) = rngF.Offset(0, 12).FormulaR1C1 ' T
            .Cells(lngZ, 18) = rngF.Offset(0, 11).FormulaR1C1 ' R
            ' Spalte AC in Kapmaßnahme und Spalte U (Round Lot)in Datenblatt AlleBestände_alleFonds
            ' .Cells(lngZ, 29) = rngF.Offset(0, 17)
            ' ----------------------------------------------------------------------- neu Anfang
            If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
            .Cells(lngZ, 21) = specialdividend ' schreibe in Spalte U
                If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
            .Cells(lngZ, 13) = Sheets("Parameter").Range("q8").FormulaR1C1 ' schreibe in Spalte U
            ' Formel für die Berechnung des EX - Prices wird in Spalte AB in Datenblatt "KapMaßnahme" kopiert
            If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
            .Cells(lngZ, 28) = Sheets("Parameter").Range("b22").FormulaR1C1
            'If .Cells(lngZ, 1) = 1 And .Cells(lngZ, 4) = ISIN Then Selection.Delete shift:=xlDown
            ' ----------------------------------------------------------------------- neu Ende
            Set rngF = rngSuch.FindNext(rngF)
        Loop While Not rngF Is Nothing And rngF.Row <> lngErst
    End With
    
    
    '>> Hier fehlt in deinem Makro die IF-Bedingung
    'Was prüfst du hier
    If ? Then
    
    Else
        MsgBox "Die Aktie ist nicht vorhanden bzw. die Eingabe wurde abgebrochen!", vbCritical, "Nur Zahlen eingeben!"
    End If
    
    
    '>> Und nochmals "End with" ohne Sinn !!
    'kann gelöscht werden
    End With
    
    
    
    For Each Zelle In Range("F8:F40")
    last_trade_Aktie = Sheets("Parameter").Range("b3").FormulaR1C1
    If Zelle <> "" Then Zelle.Offset(0, 1) = last_trade_Aktie
    Next Zelle
    
    With Worksheets(1) '####fcs
    For Each rngRange In .Range(.Cells(ZeileStart, 21), .Cells(lngZ, 21)) '####fcs
    If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
    Next rngRange
    End With
    
    With Worksheets(1) '####fcs
    For Each rngRange In .Range(.Cells(ZeileStart, 13), .Cells(lngZ, 16)) '####fcs
    If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
    Next rngRange
    End With
    
    'es wird in leere Zeele in Spalte 28 (Ex - Price) gesucht und Formel aus vorheriger Zelle in _
gefundene leere Zelle kopiert

    With Worksheets(1) '####fcs
    For Each rngRange In .Range(.Cells(ZeileStart, 28), .Cells(lngZ, 28)) '####fcs
    If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
    Next rngRange
    End With
    
    With Worksheets(1) '####fcs
    For Each rngRange In .Range(.Cells(ZeileStart, 29), .Cells(lngZ, 29)) '####fcs
    If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
    Next rngRange
    End With
    
    With Worksheets(1) '####fcs
    For Each rngRange In .Range(.Cells(ZeileStart, 26), .Cells(lngZ, 26)) '####fcs
    If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
    Next rngRange
    End With
End Sub

Gruss Rainer
Anzeige
AW: kann mir jmd. helfen?
02.02.2010 13:45:05
meixner
Hallo Rainer,
vielen Dank für deine Mühe. Aber wenn ich das Makro anwende, wie Du es oben hast (habe if ..then und end with) gelöscht, funktioniert das Makro auch nicht. Bekomme die Fehlermeldung Laufzeitfehler 438. Objekt unterstützt diese Eigenschaft oder Methode nicht.
Viele Grüße
Dani
Verwende das Makro jetzt so:
Sub reinvestment()
Dim strRIC As String, rngSuch As Range 'Variablen deklarieren
Dim rngF As Range, lngZ As Long, lngErst As Long
' ----------------------------------------------------------------------- neu Anfang
Dim specialdividend As Double
Dim AS_Geschäft As Range
Dim Fondsnummer As Long
' ----------------------------------------------------------------------- neu Ende
Dim rngRange As Range
Dim ZeileStart As Long
' RIC wird gesucht in AlleBestände_alleFonds in Spalte C;
' Eingabe von RIC für das erste Bezugsrecht in A35, C8
ISIN = InputBox("Bitte ISIN Aktie eingeben:", "Dateneingabe:")
If ISIN = vbNullString Then Exit Sub
specialdividend = Application.InputBox("Bitte Betrag der special Dividend oder Capital  _
Return eingeben:", "Dateneingabe:", , , , , , 1)
If specialdividend = False Then Exit Sub
'Jedesmal wenn der in der Inputbox eingegebene ISIN in Datenblatt
'AlleBeständealleFonds Spalte D gefunden wird, wird der RIC in Datenblatt 'Kapmaßnahme'  _
Spalte C eingetragen
With Workbooks("Template_alle_Kapitalmaßnahmen.xls")
Set rngSuch = .Worksheets(2).Columns(4)
Set rngF = rngSuch.Find(What:=ISIN, LookAt:=xlPart)
' Set rngSuch = .Worksheets(2).Columns(1)
' Set rngF = rngSuch.Find(What:=Fondsnummer, LookAt:=xlPart
If .Cells(lngErst, 1) = 1 Then
With .Worksheets(1)
lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row 'letzte in Sp.D belegte Zeile
ZeileStart = lngZ + 1
End With
End If
Do
'Sheets(5).Range("B5").Value = strRIC
lngZ = lngZ + 1 ' nächste (leere) Zeile
.Cells(lngZ, 1) = rngF.Offset(0, -3) ' a
.Cells(lngZ, 2) = rngF.Offset(0, -2) ' b
.Cells(lngZ, 3) = rngF.Offset(0, -1) ' C
.Cells(lngZ, 4) = ISIN ' d
.Cells(lngZ, 5) = rngF.Offset(0, 1) ' e
.Cells(lngZ, 6) = rngF.Offset(0, 2) ' f
.Cells(lngZ, 17) = rngF.Offset(0, 6) ' Q
.Cells(lngZ, 12) = rngF.Offset(0, 4) ' L
.Cells(lngZ, 20) = rngF.Offset(0, 12).FormulaR1C1 ' T
.Cells(lngZ, 18) = rngF.Offset(0, 11).FormulaR1C1 ' R
' Spalte AC in Kapmaßnahme und Spalte U (Round Lot)in Datenblatt AlleBestä _
nde_alleFonds
' .Cells(lngZ, 29) = rngF.Offset(0, 17)
' ----------------------------------------------------------------------- neu  _
Anfang
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 21) = specialdividend ' schreibe in Spalte U
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 13) = Sheets("Parameter").Range("q8").FormulaR1C1 ' schreibe in Spalte  _
U
' Formel für die Berechnung des EX - Prices wird in Spalte AB in Datenblatt "KapMaß _
nahme" kopiert
If .Cells(lngZ, 5) = .Cells(lngZ - 1, 5) Then _
.Cells(lngZ, 28) = Sheets("Parameter").Range("b22").FormulaR1C1
'If .Cells(lngZ, 1) = 1 And .Cells(lngZ, 4) = ISIN Then Selection.Delete shift:= _
xlDown
' ----------------------------------------------------------------------- neu Ende
Set rngF = rngSuch.FindNext(rngF)
Loop While Not rngF Is Nothing And rngF.Row  lngErst
End With
For Each Zelle In Range("F8:F40")
last_trade_Aktie = Sheets("Parameter").Range("b3").FormulaR1C1
If Zelle  "" Then Zelle.Offset(0, 1) = last_trade_Aktie
Next Zelle
With Worksheets(1) '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 21), .Cells(lngZ, 21)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
With Worksheets(1) '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 13), .Cells(lngZ, 16)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
'es wird in leere Zeele in Spalte 28 (Ex - Price) gesucht und Formel aus vorheriger Zelle  _
in _
gefundene leere Zelle kopiert
With Worksheets(1) '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 28), .Cells(lngZ, 28)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
With Worksheets(1) '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 29), .Cells(lngZ, 29)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
With Worksheets(1) '####fcs
For Each rngRange In .Range(.Cells(ZeileStart, 26), .Cells(lngZ, 26)) '####fcs
If IsEmpty(rngRange) Then rngRange = rngRange.Offset(1, 0).FormulaR1C1
Next rngRange
End With
End Sub

Anzeige
AW: kann mir jmd. helfen?
02.02.2010 14:24:17
Ramses
Hallo
Da ich deine Datei nicht kenne, kann ich das nciht nachvollziehen.
Mit meinen Codeänderungen "If" und "End If" hat das nichts zu tun.
Welche Zeile wird denn markiert wenn du auf debuggen gehst ?
Am besten wäre es, wenn du die Datei mal hochladen könntest
Gruss Rainer
AW: kann mir jmd. helfen?
02.02.2010 14:43:44
meixner
Hallo Rainer,
das Makro bleibt hier stehen: If .Cells(lngErst, 1) = 1 Then
mit der Fehlermeldung Laufzeitfehler 438. Objekt unterstützt diese Eigenschaft oder Methode nicht.
Hochladen der Datei ist ein bisschen problematisch, da diese von der Arbeit ist und einige sensible Daten darauf sind.
Viele Grüße und vielen Dank.
Dani.
Anzeige
Evtl noch offen.
02.02.2010 15:10:32
Ramses
Hallo
Das Makro ist nicht vollständig, bzw. nicht korrekt von Dir hier eingestellt worden.
In dem makro das du gezeigt hast, gibt es keine Variable "lngErst". Daher ging ich dvon aus, dass diese Variable irgendwo in deiner Mappe existiert.
Diese Variable hat demzufolge keinen Wert und die angegebene Zelle kann dann logischerweise auch nicht geprüft werden, was zu der besagten Fehlermeldung führt.
Alternativ kann ich Dir nur noch den tipp geben die Zeile in
If .Cells(rngF.Row, 1) = 1 Then
zu ändern.
Aber du musst dann natürlich auch noch definieren was dann geschehen soll, wenn keine 1 dort steht.
Und bei aller Liebe,... das bau ich nicht nach.
Entweder Datei zum testen oder hier ist Ende.
Tut mir leid
Gruss Rainer
Anzeige
AW: Evtl noch offen.
02.02.2010 15:45:33
meixner
Hallo Rainer,
ich habe Dir von Anfang an das ganze Makro reingestellt. Du kannst es gerne anhand vorheriger Kommentare überprüfen. lngErst war von Anfang mit dabei und als Variable definiert. Ich dachte Du beziehst Dich mit Absicht auf die gleiche Variable und willst keine neue definieren. Meine VBA - Kenntnisse sind leider auch aber nicht so doll.
Die Datei kann ich hier nicht reinstellen.
Natürlich musst Du mir nicht helfen, allerdings sind wir auch kein Stück weitergekommen....
Ich muss mir was anderes überlegen. Bei diesem Makro hatte mir damals der Eric aus diesem Forum stark geholfen.
Vielen Dank trotzdem für deine Mühe.
Dani.
I
Anzeige
Noch offen...
02.02.2010 15:57:01
Ramses
Hallo
Hier https://www.herber.de/forum/messages/1135073.html hast du gesagt, ist das ganze Makro.
Auf dieses habe ich mich bezogen.
Ich weiss nicht wer Eric ist, aber FCS hat dort einen grossen Teil programmiert.
Das Problem an Foren ist, dass komplizierte aufwändige Makros geschrieben werden, die dann "wachsen". Eine Anpassung ist dann nur noch schwierig umzusetzen weil der Aufwand zum testen immer grösser wird.
Ohne Beispieldatei ist das dann in vielen Fällen eben mit vertretbaren Aufwand nicht mehr machbar.
Gruss Rainer
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige