Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
980to984
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
980to984
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Cells finden und mit Formular füllen

Cells finden und mit Formular füllen
28.05.2008 11:12:00
Jörg
Hallo Leute,
ich probiere mehre Zellen nacheinander zu finden. wurde die Zelle gefunden möchte ich
zwei Spalten rechts davon die Zelle mit einer Bezugsformel füllen lassen.
Problem hier ist ich nur eine Zeile eingetragen bekomme, und die anderen ignoriert werden.
Des weiteren wird mir in der einen gefundenen Zelle mir die Formel als Text angezeigt und leider nicht
das Ergebnis.
Hier der Code:

Cells.Find(what:="Auftrag Nr.:", LookIn:=xlValues, lookat:=xlPart).Activate
ActiveCell.Offset(0, 2).Activate
ActiveCell.Formula = "=WENN(Startseite!D6="";"";Startseite!D6)"
Worksheets(FBFile).Range(A1).Select
Cells.Find(what:="Geräte-Nr.:", LookIn:=xlValues, lookat:=xlPart).Activate
ActiveCell.Offset(0, 2).Activate
ActiveCell.Formula = "=WENN(Startseite!J12="";"";Startseite!J12)"
Worksheets(FBFile).Range(A1).Select
Cells.Find(what:="Typ:", LookIn:=xlValues, lookat:=xlPart).Activate
ActiveCell.Offset(0, 2).Activate
ActiveCell.Formula = "=WENN(Startseite!D7="";"";Startseite!D7)"
Worksheets(FBFile).Range(A1).Select
Cells.Find(what:="Kunde:", LookIn:=xlValues, lookat:=xlPart).Activate
ActiveCell.Offset(0, 2).Activate
ActiveCell.Formula = "=WENN(Startseite!K5="";"";Startseite!K5)"


Ich habe schon mehreres Probiert und finde denn fehler einfach nicht..
Lg Jörg

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

Betreff
Datum
Anwender
Anzeige
AW: Cells finden und mit Formular füllen
28.05.2008 12:07:00
Armin
Hallo Jörg,
Select benutzt nur der Macrorecorder und ist fast immer überflüssig.
Für Deinen 2. Fall schau die mal die Hilfe von VBA an (Cursor auf Find und F1).
Gruß Armin

AW: Cells finden und mit Formular füllen
28.05.2008 13:42:44
Jörg
Hi Armin,
ich habe die Funktion abgeändert und er findet auch nun die Zelle:

'Zellen finden und Formel eintragen
strSuchBegriff = "Auftrag"
With Worksheets(FBFile).Range("A1:K8")
Cells.Find(What:=strSuchBegriff, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Activate
End With
ActiveCell.Offset(0, 2).Activate
ActiveCell.Formula = "=WENN(Startseite!D6="";"";Startseite!D6)"


Aber nun bekomme ich die Formel nicht in die Zelle und erhalte immer den Laufzeitfehler 1004.
Gruß Jörg

Anzeige
AW: Cells finden und mit Formular füllen
28.05.2008 14:35:44
Armin
Hallo Jörg,
das steht in der Hilfe von Excel!!!!!
Beispiel
Dieses Beispiel findet alle Zellen im Bereich "A1:A500" des ersten Arbeitsblattes, die den Wert 2 enthalten und ändert diesen Wert in 5.
Beispiel
Dieses Beispiel findet alle Zellen im Bereich "A1:A500" des ersten Arbeitsblattes, die den Wert 2 enthalten und ändert diesen Wert in 5.
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
Gruß Armin

Anzeige
AW: Cells finden und mit Formular füllen
04.06.2008 13:17:00
Jörg
Ich komme nicht weiter auch wenn ich mich drehe udn wende.
Der Aktuelle Code ist nun folgender:

Dim gZelle As Range, sBegriff$
sBegriff = "Auftrag"
Set gZelle = Worksheets(FBFile).Columns("A:F").Find(sBegriff)
Set gZelle = gZelle.Offset(0, 2)
MSgbox FBFile & "  " & gZelle.Address(False, False)
Worksheets(FBFile).Range(gZelle.Address).FormulaR1C1 = "=WENN(Startseite!$D$6="" _
;"";Startseite!$D$6)"
.....


lg Jörg

AW: Cells finden und mit Formular füllen
04.06.2008 13:36:31
Armin
Hallo Jörg,
also wenn Du wirksame Hilfe erwartest, dann aber bitte mit Mustersheet. Mit den wenigen Schnipsel die Du uns da vorwirfst, kann man wirklich nicht sehen worin Dein Problem besteht.
Sorry.
Gruß Armin

Anzeige
AW: Cells finden und mit Formular füllen
04.06.2008 14:08:00
Jörg
Kein Problem dann sende ich euch mal das Komplette Script der Funktion.
Ich möchte ein Sheet aus einer Datei in meine vorhandene Datei importieren
und dann in dem neuen Sheet nach einen Begriff suchen und 2 Zelle weiter die Formel
eintragen:

Public Sub Import_PP4000()
Dim oBook As Excel.Workbook
Dim FileName As String
Dim Aktivfile As String
Dim Openfile As String
Dim oBcb As Object
Dim fs As Object
Dim anz As Byte
Dim strDateiName As String, StrPfad As String
Dim FBFile As String
'Abfrage Tabellen existent
Dim objWks As Worksheet
Dim blnFound As Boolean
Dim zelle As Range
Dim strSuchbegriff As String
For Each oBcb In UserForm1.MultiPage1.Pages(0).Frame1.Controls
FBFile = oBcb.Caption
Set fs = CreateObject("Scripting.FileSystemObject")
If InStr(FBFile, "PP") Then
If fs.folderexists("Q:\PP\") = True Then
StrPfad = "Q:\PP\"
Else
StrPfad = ThisWorkbook.Path & "\PP\"
If fs.folderexists(StrPfad) = False Then MSgbox "Verzeichnis für Vorlage FB/ _
PP nicht gefunden": Exit Sub
Set fldr = fs.getfolder(StrPfad) 'Quellrechner
Set sfldr = fldr.subfolders
Set fls = fldr.Files
If sfldr.Count = 0 And fls.Count = 0 Then
MSgbox "Verzeichnis für Vorlage FB/PP ist leer"
Exit Sub
End If 'sfdl
End If 'fs.folderexist
End If 'fs.folderexist q
If InStr(FBFile, "FB") Then
If fs.folderexists("Q:\FB\") = True Then
StrPfad = "Q:\FB\"
Else
StrPfad = ThisWorkbook.Path & "\FB_IBN\"
'If fs.folderexists(StrPfad) = False Then
'   MsgBox "Verzeichnis für Vorlage FB/PP nicht gefunden"
'    Exit Sub
'End If
MSgbox StrPfad
If fs.folderexists(StrPfad) = False Then MSgbox "Verzeichnis für Vorlage FB/PP  _
nicht gefunden": Exit Sub
Set fldr = fs.getfolder(StrPfad) 'Quellrechner
Set sfldr = fldr.subfolders
Set fls = fldr.Files
If sfldr.Count = 0 And fls.Count = 0 Then
MSgbox "Verzeichnis für Vorlage FB/PP ist leer"
Exit Sub
End If 'sfldr
End If 'fs.folderexist
End If 'fs.folderexist fb_IBN
Application.ScreenUpdating = False
If InStr(FBFile, "FB") And oBcb.Value = True Or InStr(FBFile, "PP") And oBcb.Value = True Then
'If ObCb.Value = True Then
For Each objWks In Worksheets
If objWks.Name = FBFile Then blnFound = True: Exit For
Next
If Not blnFound Then 'wenn die Tabelle nicht vorhanden, dann weitermachen
strDateiName = StrPfad & FBFile & ".xls"
Openfile = strDateiName
Aktivfile = ActiveWorkbook.Name
anz = ActiveWorkbook.Sheets.Count
'              On Error Resume Next 'Fehler abfangen
Workbooks.Open FileName:=Openfile
Workbooks(FBFile & ".xls").Worksheets("Tabelle1").Activate
ActiveSheet.Copy After:=Workbooks(Aktivfile).Sheets(anz)
Workbooks(Aktivfile).Worksheets("Tabelle1").Activate
ActiveSheet.Name = FBFile
Workbooks(FBFile & ".xls").Close savechanges:=False 'da nicht gespeichert  _
werden soll
'Windows(activefie).Activate
Worksheets(FBFile).Activate
Application.ScreenUpdating = True
'Zellen finden und Formel eintragen
Dim gZelle As Range, sBegriff$
sBegriff = "Auftrag"
Set gZelle = Worksheets(FBFile).Columns("A:F").Find(sBegriff)
Set gZelle = gZelle.Offset(0, 2)
MSgbox FBFile & "  " & gZelle.Address(False, False)
Worksheets(FBFile).Range(gZelle.Address).Formula = "=WENN(Startseite!$D$6="";""; _
_
Startseite!$D$6)"
End If 'blnfound
End If 'objWks
Next
End Sub


Das Script funktioniert soweit bis auf das Suchen und Formel eintragen.....
lg Jörg

Anzeige

Links zu Excel-Dialogen

Frame MultiPage

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige