Thema Datum  Von Nutzer Rating
Antwort
01.04.2011 12:40:15 Alex
NotSolved
01.04.2011 16:21:26 Severus
NotSolved
01.04.2011 16:35:37 Severus
NotSolved
05.04.2011 10:45:45 alex
NotSolved
Rot Script welches schaut bevor dem einfügen ob der Zelleninhalt schon vorhanden ist
05.04.2011 11:20:24 alex
NotSolved
05.04.2011 14:07:34 safari
NotSolved
05.04.2011 15:28:35 Severus
NotSolved
06.04.2011 09:36:19 safari
NotSolved
06.04.2011 15:52:10 Severus
NotSolved

Ansicht des Beitrags:
Von:
alex
Datum:
05.04.2011 11:20:24
Views:
1391
Rating: Antwort:
  Ja
Thema:
Script welches schaut bevor dem einfügen ob der Zelleninhalt schon vorhanden ist
Hallo Serverus, hab das ganze für mich angepasst, leider funktioniert das Script nicht, bzw. es macht gar nix. Ich suche selbst gerade nach dem Fehler. Bis jetzt aber ohne erfolg. Private Sub Werte_akutalisieren_Click() Dim filSRC As Excel.Workbook Dim strSRC As String Dim shtTRG As Excel.Worksheet Dim rngSearch As Excel.Range Dim rngZelle As Excel.Range Dim lngFreieZeile As Long Dim bolExist As Boolean On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False Set shtTRG = ThisWorkbook.Sheets("Sheet1") With shtTRG lngFreieZeile = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row + 1 strSRC = Application.GetOpenFilename("Excel-Arbeitsmappe (*.xls),*.xls,Excel2007-Arbeitsmappe (*.xlsx),*.xlsx", 1, "Importdatei auswählen...", "Importdatei", False) If strSRC = "" Or strSRC = "Falsch" Then Set shtTRG = Nothing Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub End If Set filSRC = Application.Workbooks.Open(strSRC, , True): DoEvents Set rngSearch = .Range("D1:" & CStr(lngFreieZeile - 1)) bolExist = False For Each rngZelle In rngSearch If rngZelle = filSRC.Sheets(1).Range("D1") Then rngZelle.EntireRow.Columns("B") = filSRC.Sheets(1).Range("B1") rngZelle.EntireRow.Columns("C") = filSRC.Sheets(1).Range("B1") rngZelle.EntireRow.Columns("D") = filSRC.Sheets(1).Range("D1") rngZelle.EntireRow.Columns("E") = filSRC.Sheets(1).Range("B2") rngZelle.EntireRow.Columns("F") = filSRC.Sheets(1).Range("D2") bolExist = True Exit For End If Next If bolExist = False Then .Cells(lngFreieZeile, "B") = filSRC.Sheets(1).Range("B1") .Cells(lngFreieZeile, "C") = filSRC.Sheets(1).Range("B1") .Cells(lngFreieZeile, "D") = filSRC.Sheets(1).Range("D1") .Cells(lngFreieZeile, "E") = filSRC.Sheets(1).Range("B2") .Cells(lngFreieZeile, "F") = filSRC.Sheets(1).Range("D2") End If filSRC.Close False Set filSRC = Nothing Set rngSearch = Nothing End With Set shtTRG = Nothing Application.ScreenUpdating = True Application.EnableEvents = True End Sub

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen