karlchristian
Aug 07, 2014, updated at 06:34:05 (UTC)
view4235
view3
0
Goto Top

Excel 2010 VBA automatisch erweitern mit Datensätze aus Tabelle

GermanQuestionMicrosoft OfficeMicrosoft
Hallo,

ich habe eine Excel Tabelle QUELLE wo Worte (Datenbanken) untereinander stehen.
Diese Datenbanken versuche ich per VBA in Sheets einzulesen. Um die Funktionen nicht immer manuell anzlegen zu müssen
möchte ich dieses irgendwie per VBA hin bekommen.

Hierzu verwende ich eine Funktion, in welcher ich Public Funktionen aufrufe

Die Public Funktionen sind immer identisch,
Nun möchte ich erreichen, dass per VBA automatisch anhand der Wörter aus der Tabelle QUELLE die Public Funktion angelegt wird ( mit den an den Testellen TEST bzw TEST1) angelegten Wörten.
Gleichzeitig soll geprüft werden ob die Tabellenblätter bereits vorhanden sind, falls nicht soll diese angelegt werden, weiter soll die Function_Daten_Laden mit den Wörtern aus der Tabelle mit der PublicFunktion automatisch erweitert werden.

Ich habe meine Codes mal angefügt.
Im Tabellenblatt QUELLE stehen die Werte untereinander, für welche ich das VBA automatisch erweitern möchte.

vielleicht kann mir hier jemand helfen um das Problem zu lösen (Es handelt sich hierbei um gut 180 Datenbanken die eingelesen werden sollen)

Function Daten_laden()

verlassen = False

TEST

If verlassen = True Then

verlassen = False

Exit Function

End If              'Wenn bei der ersten abfragen ein Fehler auftritt wird abgerochen  


TEST1


MSGbox " Die Daten wurden erfolgreich geladen! "  

End Function

Public Sub TEST() ' As Long  
   
   Dim objCQI As cqi
   'Login übernehmen  
   Login objCQI
   'löschen der alten Daten  
    Sheets("TEST").Select  
    Cells.Select
    Selection.ClearContents
  
   Dim sql As String, tblname As String, Server As String
   
   sql = "select * from TEST"  
        
 
   tblname = "TEST"  
   
   ' Protkollierung Startzeitpunkt der Verarbeitung  
   'Debug.Print "start CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
       
   Dim resultOfAction As String
   
   Dim stat As RETCODE
   ' Absetzen der Query  
   stat = objCQI.DoRequest4XL(ActiveWorkbook.ActiveSheet, sql, tblname, resultOfAction)
   If stat <> RETCODE.ok Then
   '   Debug.Print "Fehler bei HTTP-Request:" & vbCrLf & resultOfAction & vbCrLf & "Status: " & stat & _  
                  "SQL: " & sql  
   End If
   
   ' Protkollierung Endezeitpunkt der Verarbeitung  
   'Debug.Print "ende CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
      
   ' Messung : Dauer Senden HTTP-Request zu Empfangen HTTP-Response  
   'Debug.Print "Zeitdauer Senden der Anforderung - Antwort vom Server : " & objCQI.LastReqRespDuration  
            
   ' Objektvariable zerstören  
   Set objCQI = Nothing
   
End Sub

Public Sub TEST1() ' As Long  
   
   Dim objCQI As cqi
   'Login übernehmen  
   Login objCQI
   'löschen der alten Daten  
    Sheets("TEST1").Select  
    Cells.Select
    Selection.ClearContents
  
   Dim sql As String, tblname As String, Server As String
   
   sql = "select * from TEST1"  
        
 
   tblname = "TEST1"  
   
   ' Protkollierung Startzeitpunkt der Verarbeitung  
   'Debug.Print "start CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
       
   Dim resultOfAction As String
   
   Dim stat As RETCODE
   ' Absetzen der Query  
   stat = objCQI.DoRequest4XL(ActiveWorkbook.ActiveSheet, sql, tblname, resultOfAction)
   If stat <> RETCODE.ok Then
   '   Debug.Print "Fehler bei HTTP-Request:" & vbCrLf & resultOfAction & vbCrLf & "Status: " & stat & _  
                  "SQL: " & sql  
   End If
   
   ' Protkollierung Endezeitpunkt der Verarbeitung  
   'Debug.Print "ende CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
      
   ' Messung : Dauer Senden HTTP-Request zu Empfangen HTTP-Response  
   'Debug.Print "Zeitdauer Senden der Anforderung - Antwort vom Server : " & objCQI.LastReqRespDuration  
            
   ' Objektvariable zerstören  
   Set objCQI = Nothing
   
End Sub
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 245816

Url: https://administrator.de/contentid/245816

Printed on: April 19, 2024 at 10:04 o'clock

3 Comments
Latest comment
Goto Top
Member: colinardo
colinardo Aug 07, 2014 updated at 08:57:32 (UTC)
Goto Top
Moin karlchristian,
das waren für meinen Geschmack zu viele Public und Functions in deiner wirren Beschreibung face-big-smile
Aber so wie ich das interpretiert habe, möchtest du einfach für alle Datenbanknamen die jetzt in meinem Beispiel im ersten Arbeitsblatt ab Zelle A1 alle untereinander stehen, jeweils ein Blatt erzeugen (falls es nicht existiert) und dann dafür deine Funktion ausführen. dazu brauchst du keine weiteren Funktionen erstellen (was übrigens auch nicht funktionieren würde), sondern gibst einer einizigen Funktion das entsprechende Worksheet als Parameter mit.

Sub Daten_laden()
    Dim ws1 As Worksheet, cell As Range
    Set ws1 = Worksheets(1)
    For Each cell In ws1.Range("A1", ws1.Range("A1").End(xlDown))  
        On Error Resume Next
        If Worksheets(cell.Value) Is Nothing Then
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = cell.Value
        End If
        TEST Worksheets(cell.Value)
    Next
End Sub


Public Sub TEST(ByVal ws As Worksheet) ' As Long  
   
   Dim objCQI As cqi
   'Login übernehmen  
   Login objCQI
   'löschen der alten Daten  
    ws.Select
    Cells.Select
    Selection.ClearContents
  
   Dim sql As String, tblname As String, Server As String
   tblname = ws.Name
   sql = "select * from " & tblname  

   ' Protkollierung Startzeitpunkt der Verarbeitung  
   'Debug.Print "start CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
       
   Dim resultOfAction As String
   
   Dim stat As RETCODE
   ' Absetzen der Query  
   stat = objCQI.DoRequest4XL(ws, sql, tblname, resultOfAction)
   If stat <> RETCODE.ok Then
   '   Debug.Print "Fehler bei HTTP-Request:" & vbCrLf & resultOfAction & vbCrLf & "Status: " & stat & _  
                  "SQL: " & sql  
   End If
   
   ' Protkollierung Endezeitpunkt der Verarbeitung  
   'Debug.Print "ende CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
      
   ' Messung : Dauer Senden HTTP-Request zu Empfangen HTTP-Response  
   'Debug.Print "Zeitdauer Senden der Anforderung - Antwort vom Server : " & objCQI.LastReqRespDuration  
            
   ' Objektvariable zerstören  
   Set objCQI = Nothing
End Sub
Viel Erfolg
Grüße Uwe
Member: karlchristian
karlchristian Aug 07, 2014 at 14:08:42 (UTC)
Goto Top
Hallo Uwe,
danke für den Hinweis.

ich habe nur das Problem, dass er mir eine Tabelle Beispiel erzeugt, und eine Tabelle 1.2.3.4.... ect

beim erstmaligem ausführen des Skipts
habe ich bei Daten laden im Bereich
For Each cell In ws1.Range("A1", ws1.Range("A1").End(xlDown))

das Wort Beispiel,
keine Ahnung woher er dieses zieht.
und versucht natürlich dann eine SQL Abfrage damit zu erzeugen.

Vielleicht kannst du hier nochmal schauen
Member: colinardo
colinardo Aug 07, 2014 updated at 14:21:07 (UTC)
Goto Top
In meinem Beispiel stehen deine Tabellennamen von Zelle "A1" abwärts untereinander bis die erste leere Zelle auftaucht auf dem ersten Tabellenblatt! Das funktioniert einwandfrei.

Aber mit deiner ziemlich besch. Erklärung wo deine Daten stehen, kann ich ja nicht Hellsehen !!! Also gib die nochmal mehr Mühe um es genauer verstehen zu können. Danke.
GermanQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment