Excel VBA – 从用户表格填充单元格的顺序 – 似乎几乎是随机的?

也许这篇文章有点长,但是我希望你能读一下,对我有一些帮助。

我一直在努力制作焊工资格考试logging(WQTR)的用户表格。 由于表单是107个​​字段,我创build了一个相当复杂的模块,允许用户保存他们的进度。 而是input冗长的解释,我在这里添加完成的模块。 我在代码中做了详细的评论,但是让我知道是否需要解释。

一切都编译好,它做我希望它做的一个例外。 我假设(不知道为什么),脚本读取文本框的顺序并input到工作表(全部在一行中)将与选项卡顺序同步。 但是,情况并非如此。 事实上,我看不出特别的顺序。 我认为这与我如何根据用户表单中的标签创build列的标题有关,但我不确定。 尽pipe我将所有标签的TabStop属性设置为False,但我确实确保标签按照Tab键顺序排列。

下面是我在模块中的代码。 我还有其他几个模块,但没有一个对这个问题有任何影响。

Option Explicit Dim ws As Worksheet Dim welderNameEntered As String Dim welderName_ As Variant Dim welderFirstName As String Dim welderMiddlename As String Dim welderLastName As String Dim sheetName As String Dim arrayLength As Integer '******************************************************************************** '***Controls the order of execution in this module for all Subs and Functions.*** '******************************************************************************** Public Sub TempSaveProgress() Application.ScreenUpdating = False Call SplitName funcCheckAndAddNewSheet sheetName Call SaveData Call Protection.DangerMouse(sheetName) Application.ScreenUpdating = True ActiveWorkbook.Save End Sub '************************************************************************************ '***Splits the Welders's first and last names by the space between them and grabs**** '***the first three characters of each. Sets the value of the sheetname variable*** '************************************************************************************ Sub SplitName() welderNameEntered = WQTR_Form.welderNameText.Value welderName_ = Split(welderNameEntered, " ") Dim arrayLength As Integer arrayLength = UBound(welderName_) - LBound(welderName_) + 1 Dim answer As Long If arrayLength = 0 Then Call ArrayLengthZero Exit Sub ElseIf arrayLength = 1 Then Call ArrayLengthOneAndThree Exit Sub ElseIf arrayLength = 2 Then welderFirstName = Left(welderName_(0), 3) welderLastName = Left(welderName_(1), 3) sheetName = "Temp-" + welderLastName + "-" + welderFirstName ElseIf arrayLength = 3 Then welderFirstName = Left(welderName_(0), 3) welderMiddlename = Left(welderName_(1), 1) welderLastName = Left(welderName_(2), 3) sheetName = "Temp-" + welderLastName + "-" + welderFirstName + "-" + welderMiddlename ElseIf arrayLength > 3 Then Call ArrayLengthOneAndThree Exit Sub End If End Sub '************************************************************************************** '***Adds and new worksheet after all other worksheets and gives it a temporary name.*** '************************************************************************************** Function funcCheckAndAddNewSheet(argCheckAndAdd As String) For Each ws In ThisWorkbook.Worksheets If argCheckAndAdd = ws.Name Then Call SheetNameAlreadyExists End If Next ws If sheetName <> "" Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = argCheckAndAdd End If End Function '***************************************** '***Message if the arrayLength is zero *** '***************************************** Sub ArrayLengthZero() Dim answer As Long answer = MsgBox("You must enter a welder's name in order to Save Your Progress.", vbOKOnly, "No name?") End Sub '************************************************** '***Message if the arrayLength is One or Three. *** '************************************************** Sub ArrayLengthOneAndThree() Dim answer As Long answer = MsgBox("The Welder's Name you entered is not valid. The name must conform to one these examples:" + _ vbNewLine + vbNewLine + _ " 1. FirstName LastName as in John Doe." + vbNewLine + _ " 2. FirstName MiddleName LastName as in Franklin Deleno Roosevilt." + vbNewLine + _ " 3. FirstName MiddleInitial LastName as in Joe D. Public." + vbNewLine + vbNewLine + _ "You also must make sure that names are no more than three names. " + _ "A name such as Roy Wayne David Johnson will not work. " + _ "In such cases, one of the two middle names must be omitted." _ , vbOKOnly, "Name is incorrect") End Sub '****************************************************************************** '***Message if sheetName matches the name of an already existing worksheet. *** '****************************************************************************** Sub SheetNameAlreadyExists() Dim answer As Long answer = MsgBox("A WorkSheet by by the name " + sheetName + " already exists." + _ " Did you already Save Progress for this welder on another occasion?" + _ " If so, would you like to overwrite the data in the Worksheet named " + _ sheetName + "?", vbYesNo, sheetName + " Already Exists.") If answer = vbYes Then Call SafeMouse Worksheets(sheetName).Activate Application.DisplayAlerts = False Worksheets(sheetName).Delete Application.DisplayAlerts = True Exit Sub Else Exit Sub End If End Sub '**************************************************************************************** '***Sets the Active Sheet for all of the subs it calls. Again, this basically *** '***controls the order of execution. Then does some minor worksheet level formatting. *** '**************************************************************************************** Private Sub SaveData() Worksheets(sheetName).Activate Call LabelNames Call LabelCaptions Call TextBoxText Call DeleteEmptyColumns '-----Worksheet-level Formatting----- Worksheets(sheetName).range("A1:DD1").Font.Bold = True Worksheets(sheetName).Columns("A:DD").AutoFit End Sub '*************************************************************************************** '***Takes the names of all of the form lables and enters them in the first row of the*** '***active sheet. *** '*************************************************************************************** Private Sub LabelNames() Dim ctlLblName As control Dim col As Integer: col = 0 For Each ctlLblName In WQTR_Form.Controls If TypeName(ctlLblName) = "Label" Then col = col + 1 Cells(1, col).Value = ctlLblName.Name Cells(1, col).Interior.ColorIndex = 15 End If Next ctlLblName End Sub '******************************************************************************************* '***Takes the captions of all of the form lables and enters them in the second row of the*** '***active sheet. *** '******************************************************************************************* Private Sub LabelCaptions() Dim ctlLblCaption As control Dim col As Integer: col = 0 For Each ctlLblCaption In WQTR_Form.Controls If TypeName(ctlLblCaption) = "Label" Then col = col + 1 Cells(2, col).Value = ctlLblCaption.Caption Cells(2, col).Interior.ColorIndex = 6 End If Next ctlLblCaption End Sub '*************************************************************************************************** '***The Label Names and the TextBox Names were made to be identical except for the last part of *** '***the names which are "Label" and "Text", respectively. This code finds all TextBox Names, *** '***strips "Text" out of the TexBox Name and replaces it with "Label" which makes it identical *** '***to the Label Name. Then it searches for the label name in the active sheet. When a match *** '***found it inserts the TextBox.Text Value (entered by the user) in the cell in row three. *** '*************************************************************************************************** Private Sub TextBoxText() Dim ctlTxtBx As control Dim col As Variant: col = 0 Dim strTextBoxName As String Dim strShortenedTxtBxName As String Dim strConvertedTxtBxName As String For Each ctlTxtBx In WQTR_Form.Controls If TypeName(ctlTxtBx) = "TextBox" Then strTextBoxName = ctlTxtBx.Name strShortenedTxtBxName = Left(strTextBoxName, Len(strTextBoxName) - 4) strConvertedTxtBxName = strShortenedTxtBxName + "Label" col = Application.Match(strConvertedTxtBxName, Worksheets(sheetName).Rows(1), 0) col = CInt(col) Cells(3, col).Value = ctlTxtBx.Text End If Next ctlTxtBx End Sub '****************************************************************************************************** '***Search columns from A through DF (110) and deletes columns where the cell in row three is empty.*** '****************************************************************************************************** Private Sub DeleteEmptyColumns() Dim col As Integer For col = 110 To 1 Step -1 If Cells(3, col) = "" Then ActiveSheet.Columns(col).Delete End If Next col End Sub 

所以,我会根据Tab顺序预期的是以下内容

 '| welderNameLabel | testDateLabel | wqtrNumberLabel | shopLabel | companyNameLabel | revisionNumberLabel | wpsNumberLabel | bm1_specificationLabel | '|---------------- | ------------- | --------------- | --------- | ---------------- | ------------------- | -------------- | ---------------------- | '| Welder Name | Test Date | WQTR Number | Shop | Company Name | Revision Number | WPS Number | Specification | '|---------------- | ------------- | --------------- | --------- | ---------------- | ------------------- | -------------- | ---------------------- | '| Dean Marin | 5-23-2017 | DM-1234-6G-FCAW | Bravo | ABC Company | Rev. 0 | 12345 | AWS D1.1 Code | 

我实际得到的是这样的:

 '| testDateLabel | welderNameLabel | companyNameLabel | shopLabel | wqtrNumberLabel | revisionNumberLabel | wpsNumberLabel | bm1_specificationLabel | '| ------------- | --------------- | ---------------- | --------- | --------------- | ------------------- | -------------- | ---------------------- | '| Test Date | Welder Name | Company Name | Shop | WQTR Number | Revision Number | WPS Number | Specification | '| ------------- | --------------- | ---------------- | --------- | --------------- | ------------------- | -------------- | ---------------------- | '| 5-23-2017 | Dean Marin | ABC Company | Bravo | DM-1234-6G-FCAW | Rev. 0 | 12345 | AWS D1.1 Code | 

我已经testing了很多次,并且总是把数据放在工作表中。 我可以编写一些代码来按照我想要的顺序sorting,但是在我这样做之前,我想发布这个问题,看看有没有人对它为什么会这样。 我有点担心,我会写一些东西来对列进行sorting,然后后来发现我的实验是误导性的,数据input的顺序实际上比随机显示更为随机。

我的代码简单地为用户表单中的每个文本框编写了一行代码,并明确指定了数据应该到达的确切单元格,但是我希望能够在我已经计划的其他工作簿中更加通用,因为它们都是相关的(焊接程序,程序资格和焊工资格连续性日志)。

也许在input数据之前,有人知道控制这个顺序的一些方法,而不是事后做一些sorting操作?

我很欣赏任何回应。

更新和答复

我同意jsotola,它必须是他们按照他们创build的顺序sorting。 jsotola提供了一些代码列出的顺序,我跑了好几次,总是得到完全相同的顺序完全相同的列表。

谜团已揭开!

如果你有兴趣,这里是列表。 我非常同意答案的部分原因是,从记忆中,我可以说这是我添加控件到表单的顺序。 如果你浏览控件,你会看到有一个逻辑分组的名称。 当你读下列表时,它们是相互关联的。

 bm1_tubeSizeText bm1_pipeFrame bm1_pipeDiameterLabel bm1_pipeDiameterText baseMetalFrame2 bm2_baseMetalListBox bm2_specificationLabel bm2_specificationText bm2_awsGroupNumberText bm2_awsGroupNumberLabel bm2_gradeLabel bm2_gradeText bm2_plateFrame bm2_plateThicknessLabel bm2_plateThicknessText bm2_tubeFrame bm2_tubeWallThicknessLabel bm2_tubeWallThicknessText bm2_tubeSizeLabel bm2_tubeSizeText bm2_pipeFrame bm2_pipeSizeLabel bm2_pipeSizeText bm2_pipeSheduleLabel bm2_pipeSheduleText bm2_pipeDiameterLabel bm2_pipeDiameterText actualTestValuesFrame atv_TypeOfWeldJointText atv_filletPipeDiameterText atv_filletPipeDiameterLabel atv_baseMetalLabel atv_baseMetalText atv_filletFrame atv_filletPipeTubeThicknessLabel atv_filletPipeTubeThicknessText atv_filletPlateThicknessLabel atv_filletPlateThicknessText atv_weldingFrame atv_processLabel atv_processText atv_TypeOfWeldJointLabel atv_grooveFrame atv_groovePipeTubeThicknessLabel atv_groovePipeTubeThicknessText atv_groovePlateThicknessLabel atv_groovePlateThicknessText atv_groovePipeDiameterLabel atv_groovePipeDiameterText atv_processTypeLabel atv_processTypeText atv_backingLabel atv_backingText atv_weldingProcessFrame atv_InstructionLabel_1 atv_InstructionLabel_2 atv_fillerMetalFrame atv_awsSpecLabel atv_awsSpecText atv_awsClassificationLabel atv_awsClassificationText atv_fNumberLabel atv_fNumberText atv_positionFrame atv_positionWeldedLabel atv_positionWeldedText rq_transferModeLabel rq_transferModeText rq_progressionLabel rq_progressionText atv_InstructionLabel_3 rq_InstructionLabel_4 rq_InstructionLabel_5 rq_singleOrMultipleElectrodesLabel rq_singleOrMultipleElectrodesText rq_gasFluxTypeLabel rq_gasFluxTypeText rangesQualiifedFrame rq_weldingFrame rq_weldingProcessFrame rq_processLabel rq_processText rq_processTypeLabel rq_processTypeText rq_backingLabel rq_backingText rq_InstructionLabel_1 rq_InstructionLabel_2 rq_fillerMetalFrame rq_awsSpecLabel rq_awsSpecText rq_awsClassificationLabel rq_awsClassificationText rq_fNumberLabel rq_fNumberText rq_positionFrame rq_groovePipe24DownLabel rq_groovePipe24DownText rq_groovePlatePipe24UpLabel rq_groovePlatePipe24UpText rq_filletPlatePipe24UpLabel rq_filletPlatePipe24UpText rq_filletPipe24DownLabel rq_filletPipe24DownText rq_TypeOfWeldJointLabel rq_TypeOfWeldJointText rq_baseMetalLabel rq_baseMetalText rq_filletFrame rq_filletPipeTubeThicknessLabel rq_filletPipeTubeThicknessText rq_filletPlateThicknessLabel rq_filletPlateThicknessText rq_filletPipeDiameterLabel rq_filletPipeDiameterText rq_grooveFrame rq_groovePipeTubeThicknessLabel rq_groovePipeTubeThicknessText rq_groovePlateThicknessLabel rq_groovePlateThicknessText rq_groovePipeDiameterLabel rq_groovePipeDiameterText atv_gasFluxTypeText atv_transferModeLabel atv_transferModeText atv_progressionLabel atv_progressionText atv_InstructionLabel_4 atv_InstructionLabel_5 atv_singleOrMultipleElectrodesLabel atv_singleOrMultipleElectrodesText atv_gasFluxTypeLabel testResultsFrame acceptanceCriteria_1Label acceptanceCriteria_1Text typeOfTest_1Label typeOfTest_1Text results_1Label results_1Text remarks_1Label remarks_1Text acceptanceCriteria_3Text typeOfTest_3Text results_3Text remarks_3Text acceptanceCriteria_2Text typeOfTest_2Text results_2Text remarks_2Text acceptanceCriteria_4Text typeOfTest_4Text results_4Text remarks_4Text acceptanceCriteria_5Text typeOfTest_5Text results_5Text remarks_5Text certificationFrame laboratoryLabel laboratoryText testConductedByLabel testNumberLabel testNumberText fileNumberLabel fileNumberText certStatementLabel_1 codeYearText certStatementLabel_2 certStatementLabel_3 manufacturerOrContractorLabel manufacturerOrContractorText authorizedByLabel authorizedByText dateLabel dateText finishFrame finishInstructionsLabel saveProgressButton rq_positionsQualifiedFrame testConductedByText AbortButton typeOfTest_2Label acceptanceCriteria_2Label results_2Label remarks_2Label typeOfTest_3Label typeOfTest_4Label typeOfTest_5Label acceptanceCriteria_3Label acceptanceCriteria_4Label acceptanceCriteria_5Label results_3Label results_4Label results_5Label remarks_3Label remarks_4Label remarks_5Label WelderIDLabel WelderIDText 

这将显示窗体控件的创build顺序

 Private Sub UserForm_Click() ' runs when form background is clicked Stop ' put here so that the code window shows up ( press F8 or F5 to continue) Dim i As Integer For i = 0 To UserForm1.Controls.Count - 1 Debug.Print UserForm1.Controls(i).Name Next i stop End Sub