VBA动态查找命名列,然后在找到后填充文本

时间:2016-12-31 18:22:41

标签: excel vba excel-vba

我有一个命名表,我正在尝试动态查找名为“Quarters”的列,然后以重复方式向列中添加1,2,3,4,直到找到最后一行。

也就是说,最终结果应如下所示:

Quarter
1
2
3
4
1
2
3
.....

我已经将一些代码拉到一起,如下所示,可以找到(动态)列“Quarter”,但后来我不确定如何从那里填充列。好吧,我尝试的是导致错误。我知道这一定很简单。有什么建议吗?

Sub Add_Quarters_Dynamic_Code()

Dim TargetColumn As Range
Dim FinalRow As Long
Dim rngAddress As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

Sheets(1).Select
FinalRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

Set rngAddress = Range("A:Z").Find("Quarter")
Set TargetColumn = 'So this is where I get lost....

For i = 2 To FinalRow Step 4
    Cells(i, TargetColumn).Resize(, 1).Value = 1
Next i

For j = 3 To FinalRow Step 4
    Cells(j, TargetColumn).Resize(, 1).Value = 2
Next j

For k = 4 To FinalRow Step 4
    Cells(k, TargetColumn).Resize(, 1).Value = 3
Next k

For l = 5 To FinalRow Step 4
    Cells(l, TargetColumn).Resize(, 1).Value = 4
Next l

End Sub

4 个答案:

答案 0 :(得分:0)

尝试下面的代码,代码中的解释(作为注释)

var todos = ["Buy New Turtle"];

var input = prompt("What would you like to do?");

while(input !== "quit") {
  if(input === "list") {
  	listTodos();
  }
  else if(input === "new") {
	addTodo();
  }
  else if(input === "delete") {
  	deleteTodo();
  }
  input = prompt("What would you like to do?");
}
console.log("OK YOU QUIT THE APP");

function listTodos() {
	console.log("**********")
  	todos.forEach(function(todo, i) {
	console.log(i + ": " + todo);
    });
    console.log("**********");
}

function addTodo() {
	var newTodo = prompt("Enter new todo");
	todos.push(newTodo);
	console.log("Added Todo");
}

function deleteTodo() {
	var index = prompt("Enter Index of Todo to Delete");
  	todos.splice(index, 1);
  	console.log("Deleted Todo");
}

答案 1 :(得分:0)

您提到您有一个命名表。如果这是一个Excel表,那么您也可以使用listObject对象并获取名为Quarter的列。

Public Sub fillQuarterColumn()

  Dim quarter As ListColumn
  'need error handling here in case table name or column name have changed
  Set quarter = Sheet2.ListObjects("myTable").ListColumns.Item("Quarter")

  Dim cell As Range
  Dim count As Long

  For Each cell In quarter.DataBodyRange
        cell.Value = (count Mod 4) + 1
        count = count + 1
  Next cell

End Sub

答案 2 :(得分:0)

我使用了一些答案的组合,这可能会给你一些错误,就像你没有足够的资源来做这件事,因为它会转到最后一行。但是你将FinalRow设置为它将会去那里。

Sub Add_Quarters_Dynamic_Code()
Dim FinalRow As Long
Dim rngAddress As Integer
Sheets(1).Select
FinalRow = ActiveSheet.Cells(Rows.Count, "A").End(xlDown).Row
rngAddress = Range("A:Z").Find("Quarter").Column
Cells(2, rngAddress).Value = "=MOD(ROWS($1:1)-1,4)+1"
Cells(2, rngAddress).Select
Selection.AutoFill Destination:=Range(Cells(2, rngAddress), Cells(FinalRow, rngAddress)), Type:=xlFillDefault
End Sub

答案 3 :(得分:-1)

一个很短的代码:

With Sheets(1)
    Intersect(.Range("A:Z").Find("Quarter").EntireColumn, .UsedRange.Offset(1).Resize(.UsedRange.Rows.count - 1)).Formula = "=MOD(ROWS($1:1)-1,4)+1"
End With