Excel VBA随机显示Userform

我刚刚进入VBA编程，并有其他编程经验。

我将首先描述这个macros的意图：

所以，有数量的Excel文件中有数据。 所有这些文件遵循相同的基本devise：列A包含我想要的数据的“名称”。 有十行不同的名字。 列M包含与列A的名称相对应的数据（中间的列的平均值）。这个平均数据必须被传送到“主”Excel文件。

我做了一个用户表单来select需要导入的文件，这似乎工作正常（至lessselect文件）

我使用我的模块调用用户窗体

usrform.show 

如上所述，我可以运行用户窗体。 就在我单击应用程序内的用户窗体时，它将停止代码并打开Excel VBA编辑器并显示graphics用户窗体。 不知道是什么原因造成的。 你们有没有input？

 Public strListe_selected() As String Public booDatenAbbrechen As Boolean Sub Ergebnisse_einlesen() Dim datei As String Dim liste As String Dim test As Variant Dim name As String Dim nPh As Integer Dim Suche As String Dim Excel_Daten() As Variant Dim rngFound As Range Dim rngFound1 As Range Dim Komponente() As String Dim startreihe As Integer Dim SMK As String Dim dateinr As Integer Dim strdatumformatiert As String Dim strerstellungsdatum() As String Dim intantwort As Integer Dim strdatum As String Dim Phase As String '*************************************Zeit messen um Einlesezeit zu optimieren Dim t t = Now '*************************************Zeile controlieren, somit kein daten in die falsche zeile kommt startreihe = ActiveCell.Row If startreihe < 10 Then MsgBox "Bitte markieren sie die Zeile in der die neuen Testdaten eingetragen werden sollen und führen sie das Makro erneut aus" Exit Sub ElseIf Cells(startreihe, 3) <> "" Then antwort = MsgBox("Die markierte Zeile enthält bereits Daten, wollen sie diese überschreiben?", vbOKCancel) If antwort = vbCancel Then Exit Sub End If '************************************Sammeln von Informationen über diese Arbeitsmappe liste = ThisWorkbook.ActiveSheet.name letztespalte = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column name = ThisWorkbook.name '************************************Dialogfenster öffnen xls_suchen.Show If booDatenAbbrechen = True Then Exit Sub For dateinr = 0 To UBound(strListe_selected) 'Schleife über die gewählten xls-Dateien Application.ScreenUpdating = False 'Bildschirmanzeige unterdrücken Workbooks.Open Filename:=Element & strListe_selected(dateinr) 'öffnen der xls-Datei '********************************************************************************************************************** 'neudimensionieren des ARRAYs c = 4 emdat = anzkomp * (c + 1) ReDim Excel_Daten(24 + emdat, 3) 'Spaltenüberschrift des Arrays "Excel_Daten" festlegen Excel_Daten(0, 0) = "Name" Excel_Daten(0, 1) = "Reihe" Excel_Daten(0, 2) = "Spalte" Excel_Daten(0, 3) = "Wert" '********************************************************************************************************************** '******************************** Daten aus der Excel-Datei lesen ******************************************************* i = 2 For k = 1 To anzkomp Suche = Komponente(k) Excel_Daten(i, 0) = Komponente(k) Set rngFound = Cells.Find(What:="Bemerkung:") test = Cells(rngFound.Row, rngFound.Column).Value If test = "Bemerkung:" Then anzkomp = 11 nPh = 1 ReDim Komponente(anzkomp) Testergebnis = "Phase" Komponente(1) = "F_eth" Komponente(2) = "F_Lakor_m" Komponente(3) = "F_lradap1c[0]" Komponente(4) = "F_lradap1c[1]" Komponente(5) = "F_lradap1c[2]" Komponente(6) = "F_lradap1c[3]" Komponente(7) = "F_lradap1c[4]" Komponente(8) = "F_lradap1c[5]" Komponente(9) = "F_lradap1c[6]" Komponente(10) = "F_lradap1c[7]" Komponente(11) = "Km_st_1" Else MsgBox "Der test ist nicht bekannt. Ist der Datei ein EDR Messdatei?" End If Set rngFound1 = Cells.Find(What:="Phase") If rngFound1 Is Nothing Then MsgBox Testergebnis & "nicht gefunden" Else Set rngFound = Cells.Find(What:=Suche, After:=Cells(rngFound1.Row, rngFound1.Column)) If rngFound Is Nothing Then If Suche = "F_eth" Then n = 2 If Suche = "F_Lakor_m" Then n = 5 If Suche = "F_lradap1c[0]" Then n = 8 If Suche = "F_lradap1c[1]" Then n = 11 If Suche = "F_lradap1c[2]" Then n = 14 If Suche = "F_lradap1c[3]" Then n = 17 If Suche = "F_lradap1c[4]" Then n = 20 If Suche = "F_lradap1c[5]" Then n = 23 If Suche = "F_lradap1c[6]" Then n = 26 If Suche = "F_lradap1c[7]" Then n = 29 If Suche = "Km_st_1" Then n = 32 For i = n To n + 4 If i <> n Then Excel_Daten(i, 0) = Suche & "_PH" & i - n Excel_Daten(1, 3) = "" Next i Else Excel_Daten(i, 1) = rngFound.Row Excel_Daten(i, 2) = rngFound.Column Excel_Daten(i, 3) = Cells(rngFound.Row, rngFound.Column + 12).Value i = i + 1 For j = 1 To c If j > nPh Then If Suche = "F_eth" Then n = 2 If Suche = "F_Lakor_m" Then n = 5 If Suche = "F_lradap1c[0]" Then n = 8 If Suche = "F_lradap1c[1]" Then n = 11 If Suche = "F_lradap1c[2]" Then n = 14 If Suche = "F_lradap1c[3]" Then n = 17 If Suche = "F_lradap1c[4]" Then n = 20 If Suche = "F_lradap1c[5]" Then n = 23 If Suche = "F_lradap1c[6]" Then n = 26 If Suche = "F_lradap1c[7]" Then n = 29 If Suche = "Km_st_1" Then n = 32 Excel_Daten(n + j, 0) = Suche & "_PH" & j Excel_Daten(n + j, 3) = "" i = i + 1 End If Next j End If End If Next k 'Einlesen der Ergebnisse abgeschlossen --> schließen der VTS-Datei ActiveWorkbook.Close '********************************************************************************************** '********************************************************************************************** 'Daten in gewünschtes Tabellenblatt übertragen For b = 1 To 12 ThisWorkbook.Worksheets(liste).Cells(startreihe, b + 1) = Excel_Daten(b, 3) Next b b = 12 For a = 13 To 10 + emdat ThisWorkbook.Worksheets(liste).Cells(startreihe, b + 3) = Excel_Daten(a, 3) If Excel_Daten(a, 0) = "GRAMS_KM_CO2" Or Excel_Daten(a, 0) = "GRAMS_MI_CO2" _ Or Excel_Daten(a, 0) = "FUEL_CONS_MPG" Or Excel_Daten(a, 0) = "FUEL_CONS_KPL" _ Or Excel_Daten(a, 0) = "FUEL_CONS_LP100K" Then b = b ElseIf Excel_Daten(a + 1, 0) = Excel_Daten(a, 0) & "_PH1" Then b = b + 2 End If For i = 1 To c a = a + 1 b = b + 1 ThisWorkbook.Worksheets(liste).Cells(startreihe, b + 3) = Excel_Daten(a, 3) Next i b = b + 1 'If a < emdat + 10 Then ' If test = "US06V1_FE" And VTS_Daten(a + 1, 0) = "FUEL_CONS_MPG" Then B = B + 5 'End If Next a Application.ScreenUpdating = True 'Bildschirmanzeige zulassen Next dateinr End Sub 

窗体：

 Private Sub button_cancel_Click() ReDim strListe_selected(0) 'Liste wird gelöscht booDatenAbbrechen = True Unload Me End Sub Private Sub button_all_Click() With Me.ListBox1 For i = 0 To .ListCount - 1 ListBox1.Selected(i) = True Next End With End Sub Private Sub button_none_Click() With Me.ListBox1 For i = 0 To .ListCount - 1 ListBox1.Selected(i) = False Next End With End Sub Private Sub button_apply_Click() booDatenAbbrechen = False With Me.ListBox1 liste = .List j = 0 For i = 0 To .ListCount - 1 If .Selected(i) Then ReDim Preserve strListe_selected(j) strListe_selected(j) = liste(i, 0) j = j + 1 End If Next End With Unload Me End Sub Private Sub button_add_file_Click() add_files End Sub Private Sub button_add_folder_Click() add_folder End Sub Sub add_folder() Dim objAppShell As Object Dim varBrowseDir As Variant Dim strPfad As String Dim varUnterordner As Variant Dim objFileSystem As Object Dim varOrdner As Variant Dim Element Dim strFilelist() As String Dim i As Integer Dim strFile As String Dim FD As FileDialog Set FD = Application.FileDialog(msoFileDialogFolderPicker) With FD .AllowMultiSelect = True If Application.FileDialog(msoFileDialogFolderPicker).Show = 0 Then Else strPfad = .SelectedItems(1) End If End With If strPfad = "" Then Exit Sub 'Ordner nach *.xls-Dateien durchsuchen Set objFileSystem = CreateObject("Scripting.FileSystemObject") Set varOrdner = objFileSystem.GetFolder(strPfad) Set varUnterordner = varOrdner.SubFolders i = 0 ReDim Preserve strFilelist(i) 'Hauptordner durchsuchen strFile = Dir(strPfad & "\" & "*.xls") 'Ersten Eintrag wählen Do While strFile <> "" strFilelist(i) = strPfad & "\" & strFile ListBox1.AddItem (strFilelist(i)) i = i + 1 ReDim Preserve strFilelist(i) strFile = Dir 'strFile = Dir 'Get nächsten Eintrag. Loop 'Unterordner durchsuchen For Each Element In varUnterordner strFile = Dir(strPfad & "\" & Element.name & "\" & "*.xls") Do While strFile <> "" ReDim Preserve strFilelist(i) strFilelist(i) = strPfad & "\" & Element.name & "\" & strFile ListBox1.AddItem (strFilelist(i)) i = i + 1 strFile = Dir 'strFile = Dir 'Get nächsten Eintrag. Loop Next End Sub Sub add_files() Dim FD As FileDialog Dim Element Dim i As Integer Set FD = Application.FileDialog(msoFileDialogOpen) With FD .AllowMultiSelect = True '.InitialFileName = ActiveWorkbook.Path & "\*.xls""" .Filters.Clear .Filters.Add "Excel dateien", "*.xls" End With i = 1 If FD.Show = -1 Then For Each Element In FD.SelectedItems ' datei = Dir(Element, "*.xls") ListBox1.AddItem (FD.SelectedItems(i)) Next End If End Sub