我有一张有2张桌子的工作表。 两个表都有2列，但table2的列（2）具有整数值。 我想要一段代码，它采用table2 column（2）的最小值并将table2 Column（1）粘贴在table（1）的底部。
基本上，代码将通过查找最小值来分析table2，并将表2的column1粘贴在表column1的底部。 （表2保持不变，而表1增加）。
我不知道如何解决这个问题。我已经尝试了一些方法，但是它不起作用（请参阅代码中的“无效”）。它以某种方式给我的结果不是最低的。我想念什么吗？
Sub ssNewJoinerM()
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
QuestionToMessageBox = "Do you want to add someone to a Hub ?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "New joiner Process")
If YesOrNoAnswerToMessageBox = vbYes Then
GoTo Start
Else: GoTo Finish
End If
' Double check if the user wants to start the process of adding a new employee to a Hub. If yes, start the Macro. If No, Finish now.
Start:
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet
Dim ws8 As Worksheet
Set ws1 = ActiveSheet
Set ws2 = ActiveSheet
Set ws3 = ActiveSheet
Set ws4 = ActiveSheet
Set ws5 = ActiveSheet
Set ws6 = ActiveSheet
Set ws7 = ActiveSheet
Set ws8 = ActiveSheet
Set ws1 = ThisWorkbook.Sheets("Monthly Movements")
Set ws2 = ThisWorkbook.Sheets("Howard-Marle Hub")
Set ws3 = ThisWorkbook.Sheets("Bernard Hub")
Set ws4 = ThisWorkbook.Sheets("Thomas Hub")
Set ws5 = ThisWorkbook.Sheets("Michael Hub")
Set ws6 = ThisWorkbook.Sheets("Oliver Hub")
Set ws7 = ThisWorkbook.Sheets("Lance Hub")
Set ws8 = ThisWorkbook.Sheets("John Hub")
Dim table1 As ListObject
Dim table2 As ListObject
Dim table3 As ListObject
Dim table4 As ListObject
Dim table5 As ListObject
Dim table6 As ListObject
Dim table7 As ListObject
Dim table8 As ListObject
Dim table9 As ListObject
Dim table10 As ListObject
Dim table11 As ListObject
Dim table12 As ListObject
Dim table13 As ListObject
Dim table14 As ListObject
Dim table15 As ListObject
Set table1 = ws2.ListObjects("Table1")
Set table2 = ws2.ListObjects("Table2")
Set table3 = ws1.ListObjects("Table3")
Set table4 = ws3.ListObjects("Table4")
Set table5 = ws3.ListObjects("Table5")
Set table6 = ws4.ListObjects("Table6")
Set table7 = ws4.ListObjects("Table7")
Set table8 = ws5.ListObjects("Table8")
Set table9 = ws5.ListObjects("Table9")
Set table10 = ws6.ListObjects("Table10")
Set table11 = ws6.ListObjects("Table11")
Set table12 = ws7.ListObjects("Table12")
Set table13 = ws7.ListObjects("Table13")
Set table14 = ws8.ListObjects("Table14")
Set table15 = ws8.ListObjects("Table15")
' Declaration of my objects (tables, worksheets etc..)
Dim NewJoiner As String
NewJoiner = InputBox("Enter new joiner name in the following format (Surname, First Name)", "Adding New Joiner to Hub")
Dim Position As String
Position = InputBox("Enter new joiner Position (A, C, SC, PC, MP, Partner, Admin, Analyst, Director)", "Assigning New Joiner to a position")
'Input Name and Position and stores it (Could be improved with user form...)
If Position = "" Or NewJoiner = "" Then
GoTo StringEmpty
Else: GoTo StringNotEmpty
End If
'If Position or NewJoiner name are empty, end the process. Otherwise continue
StringNotEmpty:
Dim tbl As ListObject
Dim sht As Worksheet
Dim MyTable As ListObject
'Loop through each sheet and table in the workbook
For Each sht In ThisWorkbook.Worksheets
For Each tbl In sht.ListObjects 'loop through all tables
'To omit certain tables you can do the below
If tbl.Name <> "Table2" And tbl.Name <> "Table3" And tbl.Name <> "Table5" And tbl.Name <> "Table7" _
And tbl.Name <> "Table9" And tbl.Name <> "Table11" And tbl.Name <> "Table13" And tbl.Name <> "Table15" And tbl.Name <> "Table16" Then
If MyTable Is Nothing Then
Set MyTable = tbl 'set the table if not previously set
Set MyWorksheet = sht 'set the worksheet if not previously set
ElseIf tbl.ListRows.Count < MyTable.ListRows.Count Then 'if table rows is smaller than previously set one, reset
Set MyTable = tbl
Set MyWorksheet = sht
End If
End If
Next tbl
Next sht
'DOES Not WORK
Dim Coach As String
Dim ws As Worksheet, t As ListObject, r As Long
For Each t In MyWorksheet.ListObjects
Select Case t.Name
Case "Table1", "Table3", "Table4", "Table6", "Table8", "Table10", "Table12", "Table14", "Table16"
'do nothing
Case Else
For r = t.DataBodyRange.Rows.Count To 1 Step -1
If t.DataBodyRange(r, 2) <= t.DataBodyRange(r + 1, 2) Then
Coach = t.DataBodyRange(r, 1)
End If
Next r
End Select
Next t
' Adds the NewJoiner to the Hub with least members as long as the Hub as less than 50 employees
If MyTable.ListRows.Count <= 50 Then
Set newrow1 = MyTable.ListRows.Add
With newrow1
.Range(1) = NewJoiner
.Range(2) = Position
.Range(3) = Coach
End With
'Populates the monthly movemement tab with relevant information as long as the Hub as less than 50 employees
Set newrow2 = table3.ListRows.Add
With newrow2
.Range(1) = NewJoiner
.Range(2) = Position
.Range(3) = MyWorksheet.Name
End With
'Informative message for End-User as long as the Hub as less than 50 employees (Which Hub the NewJoiner has been added to)
MsgBox (NewJoiner + " has been added to the " + MyWorksheet.Name + "." & vbNewLine & vbNewLine & "Its details can be seen on the monthly movements tab.")
' If all the HUBS have more than 50 members, the programme does not do anaything and ask for the creation of a New Hub
Else: MsgBox (" All the Hubs have more than 50 members !" & vbNewLine & vbNewLine & " A new hub needs to be created.")
End If
Finish:
StringEmpty:
'MsgBox (" You have not entered a Name or a Position for the new joiner !")
End Su
b
答案 0 :(得分：2)
假设您的表1位于A和B列，表2位于D和E列。应该是这样的：
With ActiveSheet
.Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).Value = .Range("D" & Application.Match(Application.Min(.Range("E:E")), .Range("E:E"), 0))
End With
注意：我使用了“范围”，因此您可以轻松地编辑列。
答案 1 :(得分：0)
此代码将花费2 ListObject s，然后在First的给定列中找到最小值（默认为Column 2），并将具有该值的First Row粘贴到Second {{1 }}。
它还具有ListObject选项，该选项将按顺序列出对象和变量，以便更轻松地跟踪您可能遇到的任何错误。
ShowDebug