Microsoft Excel

Herbers Excel/VBA-Archiv

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

Makro mit .Find und wenn | Herbers Excel-Forum


Betrifft: Makro mit .Find und wenn von: meixner
Geschrieben am: 01.02.2010 16:17:27

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)

  

Betrifft: ??? von: Ramses
Geschrieben am: 01.02.2010 17:51:45

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


  

Betrifft: kann mir jmd. helfen? von: meixner
Geschrieben am: 02.02.2010 10:31:03

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


  

Betrifft: AW: kann mir jmd. helfen? von: Ramses
Geschrieben am: 02.02.2010 10:48:12

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


  

Betrifft: AW: kann mir jmd. helfen? von: meixner
Geschrieben am: 02.02.2010 11:01:01

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.


  

Betrifft: Hilfe!!!!!!!! von: meixner
Geschrieben am: 02.02.2010 11:52:55

Hallo zusammen!

hat jmd. noch einen Tip bzgl. dem unteren Makro???

Viele Grüße
Dani


  

Betrifft: AW: kann mir jmd. helfen? von: Ramses
Geschrieben am: 02.02.2010 11:56:55

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


  

Betrifft: AW: kann mir jmd. helfen? von: meixner
Geschrieben am: 02.02.2010 12:37:01

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



  

Betrifft: AW: kann mir jmd. helfen? von: Ramses
Geschrieben am: 02.02.2010 13:04:11

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


  

Betrifft: AW: kann mir jmd. helfen? von: meixner
Geschrieben am: 02.02.2010 13:45:05

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



  

Betrifft: AW: kann mir jmd. helfen? von: Ramses
Geschrieben am: 02.02.2010 14:24:17

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


  

Betrifft: AW: kann mir jmd. helfen? von: meixner
Geschrieben am: 02.02.2010 14:43:44

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.


  

Betrifft: Evtl noch offen. von: Ramses
Geschrieben am: 02.02.2010 15:10:32

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


  

Betrifft: AW: Evtl noch offen. von: meixner
Geschrieben am: 02.02.2010 15:45:33

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


  

Betrifft: Noch offen... von: Ramses
Geschrieben am: 02.02.2010 15:57:01

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