如何在VBA中创build一个可以自动确定matrix边界的macros

我已经开始在VBA编程，因此我仍然是新手。

我试图制作一个自动为我定义特定区域的macros，虽然它在我的工作表中工作得很好，但它仍然是有限的，因为我使用它的所有工作表必须在设置中相同。

我目前正在定义5个方面

• A_mål – 单细胞
• Tank_Tabel – matrix
• Int_Tabel – matrix
• 外滩 – 单细胞
• HF – 单细胞

对于我的问题，最佳的macros是一个提示用户input一个容器的号码，然后使用该号码自动确定可以在哪个表上find所述容器的信息，并自动确定列出的区域的位置，并用给定的名字和用户input的号码来定义它们。

代码可以在这里看到：

Option Compare Text Sub Definer() Dim TankNr As Integer, rHF As Range, rAM As Range, rBV As Range, rTT As Range, rIT As Range If MsgBox("Vil du definere nye områder for en tank", vbYesNo, "Confirm") = vbYes Then TankNr = Application.InputBox("Indtast tank nr på den tank du vil definere områder for", "Tank Nummer", Type:=1) If TankNr <> 0 Then Set rHF = Sheets("Tank " & TankNr).Cells.Find(What:="HØJESTE FYLDEGRÆNSE =", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rHF Is Nothing Then rHF.Offset(, 3).Name = "HF_" & TankNr End If Set rTT = Sheets("Tank " & TankNr).Cells.Find(What:="Enhed i tabellen : Liter", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rTT Is Nothing Then rTT.CurrentRegion.Offset(2, 0).Resize(rTT.CurrentRegion.Rows.Count - 2).Name = "Tabel_tank" & TankNr End If Set rIT = Sheets("Tank " & TankNr).Cells.Find(What:="Interpolationstabel", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rIT Is Nothing Then rIT.Resize(11, 11).Offset(1, 0).Name = "Int_tank" & TankNr End If Set rBV = Sheets("Tank " & TankNr).Cells.Find(What:="Bundvolumen =", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rBV Is Nothing Then rBV.Offset(, 2).Name = "Bund" & TankNr End If Set rAM = Sheets("Tank " & TankNr).Cells.Find(What:="A-MÅL =", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rAM Is Nothing Then rAM.Offset(, 1).Name = "A_mål" & TankNr End If MsgBox "Områder er blevet defineret" End If End If End Sub 

这有几个问题：

1. 如果用户在input框中input一个非整数，则代码最终会出错，而不仅仅是结束macros。 解决了
2. 如果用户在input框中点击取消，代码也会以错误结束，而不是结束macros。 解决了
3. 我尝试使用input“TankNr”作为参考，但它不返回单元格的值， 但正是我所写的作为参考 解决
4. 最后，每个定义区域的当前边界是由我手动确定的，如果我正在查找的值实际上是在那些特定的单元格中，则工作正常。 有时，工作表的设置可能会有所不同，因此我需要macros能够自动确定所定义区域的边界应该被 解决的位置

有问题的床单可以看到

由于我的名誉，我只能包含这两个链接，但是如果有办法提供更多关于我的工作的文档，告诉我，我会很乐意这样做。

Answer 1

这是我将使用的方法。 这只是HF的一个例子，但希望你能明白，并可以扩展到其他范围。 我假定命名的范围是包含“HF”的单元的右边的单元格。

 Sub OptimalSolution() Dim TankNr As Integer, rHF As Range If MsgBox("Do you wish to define new areas for a container?", vbYesNo, "Confirm") = vbYes Then TankNr = Application.InputBox("Please enter the container number", "Container Number", , , , , , 1) Set rHF = Sheets("Ark" & TankNr).Cells.Find(What:="HF", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False) If Not rHF Is Nothing Then rHF.Offset(, 1).Name = "HF_" & TankNr End If End If End Sub 

Answer 2

我不确定，如果我的理解是正确的。 您可以遍历Sheet 2的起始范围的循环，以获取地址。 例如，如果“A_Mål”，“HF”，“Bundvolumen”等标签在第2页中保持不变，则可以使用：

 Sub GetRanges() Dim A2, HF2, BV2, TT2, IT For Each c In Range("A1:Z100") ' A1:Z100 is Random range, which might contain the ranges required If c.Value = "A_Mål" Then ' Check if this cell value matches A_Mål A2 = c.Offset(rowOffset:=0, columnOffset:=1).Address ' Use Offset to take the one cell to right of matching cell ElseIf c.Value = "HF" Then ' Check if this cell value matches HF HF2 = c.Offset(rowOffset:=0, columnOffset:=1).Address ' Use Offset to take the one cell to right of matching cell ElseIf c.Value = "Bundvolumen" Then ' Check if this cell value matches Bundvolumen BV2 = c.Offset(rowOffset:=0, columnOffset:=1).Address ' Use Offset to take the one cell to right of matching cell ElseIf c.Value = "CM" Then ' Check if this cell value matches HF TT2 = c.CurrentRegion.Address ' Use CurrentRegion to take the current continous data of matching cell ElseIf c.Value = "INTERPOLCATIONSTABEL" Then ' Check if this cell value matches INTERPOLCATIONSTABEL IT2 = c.Offset(rowOffset:=0, columnOffset:=1).CurrentRegion.Address ' Use Offset to take the one cell to right of matching cell ' Use CurrentRegion to take the current continous data of matching cell End If End Sub 

注意：这些variables为您提供string数据types的范围地址如果您需要实际的范围，只需从提到的每一行中删除“.address”。

注2：在表2中，勾选的标签“Bundvolumen”已经更改为“卷”。上面给出的macros不会在这种情况下工作。 但是，如果您知道可用于引用的名称的详尽列表，则可以在“IF”语句中的“OR”条件中包含该列表。 如：

 ElseIf c.Value = "Bundvolumen" or c.Value = "Volume" Then