SVerWeis Makro mit Dateiauswahl

Sub SVerWeis() ' SVerWeis Makro Windows("24.01.2017.csv").Activate ActiveCell.FormulaR1C1 = _ "=VLOOKUP(RC[-1],[25.01.2017.xls]rptAbfDataArtikelLagerbestand!R1C1:R7764C6,4,FALSE)" Selection.AutoFill Destination:=Range("C2:C200"), Type:=xlFillDefault Range("C2:C200").Select ActiveWindow.SmallScroll Down:=-186 Windows("Makrosteuerung.xlsm").Activate End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub SVerWeis() ' SVerWeis Makro Dim datCSV As String Dim datXLS As String Dim heute As Date heute = Date datXLS = Format$(heute, "dd.mm.yyyy") & ".xls" datCSV = Format$(heute - 1, "dd.mm.yyyy") & ".csv" Windows(datCSV).Activate ActiveCell.FormulaR1C1 = _ "=VLOOKUP(RC[-1],[" & datXLS & "]rptAbfDataArtikelLagerbestand!R1C1:R7764C6,4,FALSE)" Selection.AutoFill Destination:=Range("C2:C200"), Type:=xlFillDefault Range("C2:C200").Select ActiveWindow.SmallScroll Down:=-186 Windows("Makrosteuerung.xlsm").Activate End Sub

Sub SVerWeis() Dim datCSV As String Dim datXLS As String Dim heute As Date Dim wbCSV As Workbook Dim wsCSV As Worksheet heute = Date datXLS = Format$(heute, "dd.mm.yyyy") & ".xls" datCSV = Format$(heute - 1, "dd.mm.yyyy") & ".csv" Set wbCSV = Workbooks(datCSV) Set wsCSV = wbCSV.Worksheets(1) With wsCSV.Range("C2") .Formula = _ "=VLOOKUP(B2,[" & datXLS & "]rptAbfDataArtikelLagerbestand!$A$1:$F$7764,4,FALSE)" .AutoFill Destination:=wsCSV.Range("C2:C200") End With wsCSV.Activate wsCSV.Range("C2:C200").Select ThisWorkbook.Activate End Sub

Hallo Mike,
das Programm könnte so aussehen:


Sub SVerWeis_2()
Dim datCSV As String
Dim datXLS As String
Dim heute As Date
Dim letzteZeile As Long
Dim pfad As String
Dim wbCSV As Workbook
Dim wsCSV As Worksheet
Dim wbXLS As Workbook
Dim wsXLS As Worksheet
Dim zeile As Long
Dim zf As String
heute = Date
datXLS = Format$(heute, "dd.mm.yyyy") & ".xls"
datCSV = Format$(heute - 1, "dd.mm.yyyy") & ".csv"
pfad = "C:\Herber\"
' 1. Arbeitsmappe datXLS öffnen
If Dir(pfad & datXLS) = "" Then
MsgBox Prompt:="Datei """ & pfad & datXLS & """ existiert nicht!", _
Buttons:=vbCritical
Exit Sub
End If
On Error Resume Next
Workbooks(datXLS).Close SaveChanges:=False
On Error GoTo 0
Set wbXLS = Workbooks.Open(Filename:=pfad & datXLS)
Set wsXLS = wbXLS.Worksheets("rptAbfDataArtikelLagerbestand")
' 2. Arbeitsmappe datCSV öffnen
If Dir(pfad & datCSV) = "" Then
MsgBox Prompt:="Datei """ & pfad & datCSV & """ existiert nicht!", _
Buttons:=vbCritical
Exit Sub
End If
On Error Resume Next
Workbooks(datCSV).Close SaveChanges:=False
On Error GoTo 0
Set wbCSV = Workbooks.Open(Filename:=pfad & datCSV)
Set wsCSV = wbCSV.Worksheets(1)
' 3. Bei datXLS Anführungszeichen entfernen
letzteZeile = wsXLS.Cells(wsXLS.Rows.Count, "A").End(xlUp).Row
For zeile = 1 To letzteZeile
If Not IsNumeric(wsXLS.Cells(zeile, "A")) And _
Len(wsXLS.Cells(zeile, "A")) >= 2 Then
zf = wsXLS.Cells(zeile, "A")
If Left$(zf, 1) = """" And _
Right$(zf, 1) = """" Then
zf = Mid$(zf, 2, Len(zf) - 2)
If Left$(zf, 1) = "=" Then
zf = "'" & zf
End If
wsXLS.Cells(zeile, "A") = zf
End If
End If
Next zeile
' 4. SVERWEIS setzen
With wsCSV.Range("C2")
.Formula = _
"=VLOOKUP(B2,[" & datXLS & "]rptAbfDataArtikelLagerbestand!$A$1:$F$7764,4,FALSE)"
.AutoFill Destination:=wsCSV.Range("C2:C200")
End With
wsCSV.Activate
wsCSV.Range("C2:C200").Select
ThisWorkbook.Activate
End Sub

Viele Grüße
Dieter

Hallo Dieter,
nochmals vielen Dank. Ich habe mich wahrscheinlich missverständliche ausgedrückt. Die beiden Dateien sind in verschiedenen Ordner aber hier wiederum immer im gleichen. Ich müsste also für jeden Datei den Pfad angeben.
Das habe ich gelöst in dem ich für die datCSV =pfad1 verwende.
Außerdem muss die SV-Verweis Formel wieder entfernt werden, ich habe dies manuell immer mit Werte kopieren erledigt.
Als VBA Code habe ich das mir überlegt.
'wertekopieren Makro
wsCSV.Activate
Range("C2:C200").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Jetzt zum problem er öffnet die CSV - Datei falsch, alles ist in die erste Spalte verschoben, wenn ich diese manuell öffnet dann sieht alles korrekt aus.
Der SVerweis wird vielleicht dadurch nicht durchgeführt, in der Spalte C wird nur NV angezeigt. Es kann aber auch daran liegen das die Anführungszeichen in der MatrixTabelle nicht entfernt wurden. Hier nochmals genau wie diese in der Spalte angezeigt werden. (Bsp,="10000011")
Gruß Mike

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

82 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

SVerWeis Makro mit Dateiauswahl

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

82 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread