Dateipfad aus Zelle beim übertragen von Umsätzen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Dateipfad aus Zelle beim übertragen von Umsätzen
von: Tom
Geschrieben am: 28.08.2015 12:07:13

Guten Tag Zusammen
Ich habe einen VBA Code geschrieben. Dieser funktionier auch soweit ganz gut und macht was er soll:
'Überträg den Umsatz aus der Datei, welche zuerst ausgewählt wird in das Budget Excel
Option Explicit
Dim Stamm As String
Dim varFile As Variant
Dim varName As Variant
Dim Blatt As String


Public Sub Umsatz_übertragen()
 On Error GoTo Err
     Stamm = ActiveWorkbook.Name
     varFile = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Datei mit dem  _
aktuellen Umsatz Budget auswählen", False)
     If TypeName(varFile) Like "Boolean" Then
         MsgBox "Keine Datei gewählt!", vbInformation
         Exit Sub
     Else
     
     
      Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
       varName = Right$(varFile, Len(varFile) - InStrRev(varFile, "\"))
      Workbooks.Open varFile
      
Blatt = ActiveWorkbook.Path & "\[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name
       
   Workbooks(Stamm).Sheets("Umsatz").Range("E10").Value = Blatt 'schreibt den Dateipfad in  _
Zelle E10
 
   
   
  Workbooks(Stamm).Sheets("Umsatz").Range("E13:P59").FormulaR1C1 = "=SUMPRODUCT(--('[varName] _
Sales'!R6C3:R400C3=RC4),'[varName]Sales'!R6C[57]:R400C[57])"
     
             
      Workbooks(varName).Close
      
      Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic 'Automatische Berechnung aktivieren
     
Workbooks(Stamm).Sheets("Umsatz").Range("E13:P59").Copy
      Workbooks(Stamm).Sheets("Umsatz").Range("E13:P59").PasteSpecial xlPasteValues
      
      
   
   
Application.DisplayAlerts = False
Workbooks(Stamm).Sheets("Umsatz").Range("B80:P140").Copy
    Range("B12:P72").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=False
  
 Application.CutCopyMode = False
    ActiveSheet.Range("A9").Select
    
    Application.DisplayAlerts = True
     End If
   Exit Sub
    
Err:
   Call MsgBox("Bitte überprüffen ob die Tabellen" _
               & vbCrLf & "vohanden sind" _
               , vbExclamation, "Fehler")
               
     
 End Sub

Beim Eintragen der Formel Summenprodukt will er aufgrund des [varname] die Formel aktualisieren und findet natürlich keine Datei.
Ich habe es bereits mit Indirekt versucht, schaffte es aber nicht.
Das Makro sollte über einen Button gestartet werden und aus einer Datei die man auswählen kann, die Daten mit Summenprodukt zusammenzählen. Damit man sieht welche Datei ausgewählt wurde, wird der Pfad in Zelle E10 geschrieben. Anschliessend sollten die Formeln wieder gelöscht werden.
Das Makro funktioniert gut, jedoch muss man 2x die Datei auswählen. Gibt es eine Möglichkeit dies zu unterdrücken, so dass man nur noch einmal die Datei auswählen muss?
Gruss
Tom

Bild

Betrifft: Diverses
von: Michael
Geschrieben am: 30.08.2015 14:25:41
Hi Tom,
warum das "Datei öffnen" zweimal aufging, kann ich nicht nachvollziehen - es trat bei mir *ein* Mal auf, und als ich eruieren wollte, warum, war der Effekt weg.
Ich habe zunächst mal den Pfad "vorbelegt", indem ich in den Ordner gewechselt bin, in dem die Makro-Datei steckt: Du kannst die Anweisungen an Deinen Pfad für auszuwertende Datein anpassen (den Pfad in chdir Pfad).
Für Deine Formeln muß die Datei nicht geöffnet werden; ich vermute, Du hast sie nur geöffnet, um auf die Angaben in Deiner bisherigen Zuweisung von Blatt = xxx zu kommen.
Ich weiß ja nicht, wo Deine Dateien verteilt sind, deshalb ist es immer sicherer, den kompletten Pfad in die Formel mit einzufügen.
Ich hatte keine Lust, irgendwelche Daten zu erfinden, deshalb habe ich nur eine simple Formel verwendet ...

"='" & Blatt & "'!C10"

... aber Du siehst schon, worum es geht: Du darfst Variablennamen nicht einfach in den String ("") setzen, sondern mußt sie mit "Anfang & [Variablenname] & "Ende" einfügen.
Spiel mal damit herum:
Option Explicit
Public Sub Umsatz_übertragen()
Dim Stamm As Workbook
Dim varFile As Variant
Dim varName As String
Dim Blatt As String, Pfad As String
Dim pos&
 
On Error GoTo Err
Set Stamm = ActiveWorkbook
' für vorbelegten Pfad siehe auch:
' http:// _
msdn.microsoft.com/de-de/library/office/ff834966(v=office.15).aspx
' http://www.office-loesung.de/ _
ftopic293618_0_0_asc.php
Pfad = ThisWorkbook.Path
ChDrive Mid(Pfad, 1, 2)
ChDir Pfad
varFile = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , _
     "Datei mit dem aktuellen Umsatz Budget auswählen", False)
'Stop
If varFile = False Then
   MsgBox "Keine Datei gewählt!", vbInformation
   Exit Sub
End If
' Application.ScreenUpdating = False
' wozu? dann siehst Du doch gar nicht, wenn der String in E10
' geschrieben wird.
pos = InStrRev(varFile, "\")
Pfad = Mid(varFile, 1, pos)
varName = "[" & Mid(varFile, pos + 1) & "]"
'Workbooks.Open varFile
' die Datei muß nicht geöffnet sein
      
Blatt = Pfad & varName & "Sales"     ' denn unten wertest Du nur das aus
Stamm.Sheets("Umsatz").Range("E10").Value = Blatt ' Dateipfad in E10
'Stamm.Sheets("Umsatz").Range("E13:P59").FormulaR1C1 = _
'"=SUMPRODUCT(--('[varName]Sales'!R6C3:R400C3=RC4),'[varName]Sales'!R6C[57]:R400C[57])"
' Habe keine Lust, endlose Testdaten zu erfinden!
Stamm.Sheets("Umsatz").Range("E13:P59").Formula = _
  "='" & Blatt & "'!C10"
Stamm.Sheets("Umsatz").Range("E13:P59").Copy
  Stamm.Sheets("Umsatz").Range("E13:P59").PasteSpecial xlPasteValues
' Kommentar kannst wieder entfernen; in der mittleren Zeile "Stamm." ergänzt...
'Stamm.Sheets("Umsatz").Range("B80:P140").Copy
'  Stamm.Range("B12:P72").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
'    SkipBlanks:=True, Transpose:=False
Application.CutCopyMode = False
'Workbooks(varName).Close
' und dann natürlich auch nicht geschlossen
ActiveSheet.Range("A9").Select
    
Exit Sub
    
Err:
Application.ScreenUpdating = True ' wenn Du es schon vorher ausschalten mußt;
   Call MsgBox("Bitte überprüffen ob die Tabellen" _
               & vbCrLf & "vohanden sind" _
               , vbExclamation, "Fehler")
               
     
 End Sub
Schöne Grüße,
Michael

Bild

Betrifft: AW: Diverses
von: Tom
Geschrieben am: 31.08.2015 12:12:04
Hallo Michael
Du hast mir mit deinem Code sehr geholfen. Nun funktionierts wie ich es wollte.
Besten Dank.
Gruss
Tom

Bild

Betrifft: freut mich, danke für die Rückmeldung,
von: Michael
Geschrieben am: 31.08.2015 13:08:56
Tom,
und weiterhin happy exceling,
Michael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Dateipfad aus Zelle beim übertragen von Umsätzen"