英文:
First row of Filtered data not copied VBA Excel
问题
以下是代码的翻译部分:
Sub MakeAbsence()
Dim template As Worksheet
Dim data As Worksheet
Dim output As Worksheet
Dim output_remain As Worksheet
Dim teacher_list As Worksheet
Set template = ThisWorkbook.Worksheets("Template")
Set data = ThisWorkbook.Worksheets("Template_Data")
Set teacher_list = ThisWorkbook.Worksheets("Template_teacher")
' 获取老师的名字
Dim teachers_range As Variant
teachers_range = teacher_list.Range("A2:A5") ' 有没有自动化这个的想法?
' 遍历老师
Dim teacher As Variant
For Each teacher In teachers_range
' 复制模板
template.Copy After:=Worksheets(Worksheets.Count)
Set output = ActiveSheet
output.Name = teacher
' 修改名字
Dim teacher_range As Range
Set teacher_range = output.Range("A6").EntireRow.Find("[teacher]", LookIn:=xlValues)
teacher_range.Value = teacher
' 筛选数据
data.Range("B1:D" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).AutoFilter Field:=3, Criteria1:=teacher
' 复制数据
Dim data_range As Range
Set data_range = data.Range("B2:C" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
If Not data_range Is Nothing Then
' 复制前14行到输出工作表
If data_range.Rows.Count > 14 Then
data_range.Resize(14).Offset(1, 0).Copy Destination:=output.Range("B8")
' 复制剩余的行到新工作表
Dim remaining_data_range As Range
Set remaining_data_range = data_range.Resize(data_range.Rows.Count - 14).Offset(15, 0)
template.Copy After:=Worksheets(Worksheets.Count)
Set output_remain = ActiveSheet
output_remain.Name = teacher & "_2"
remaining_data_range.Copy Destination:=ActiveSheet.Range("B8")
Dim teacher_range_remain As Range
Set teacher_range_remain = output_remain.Range("A6").EntireRow.Find("[teacher]", LookIn:=xlValues)
teacher_range_remain.Value = teacher
Else
data_range.Offset(1, 0).Copy Destination:=output.Range("B8")
End If
End If
' 删除筛选
data.AutoFilterMode = False
Next teacher
End Sub
希望这对你有帮助。如果你有其他问题,请随时提出。
英文:
This is my Virtual Basic Application Code from my excel spreadsheet,(You can download it, scroll down)
Sub MakeAbsence()
Dim template As Worksheet
Dim data As Worksheet
Dim output As Worksheet
Dim output_remain As Worksheet
Dim teacher_list As Worksheet
Set template = ThisWorkbook.Worksheets("Template")
Set data = ThisWorkbook.Worksheets("Template_Data")
Set teacher_list = ThisWorkbook.Worksheets("Template_teacher")
' Getting Teacher's Names
Dim teachers_range As Variant
teachers_range = teacher_list.Range("A2:A5") 'Any idea how to automate this?
' Loop Through Teacher
Dim teacher As Variant
For Each teacher In teachers_range
' Copy Template
template.Copy After:=Worksheets(Worksheets.Count)
Set output = ActiveSheet
output.Name = teacher
' Change Name
Dim teacher_range As Range
Set teacher_range = output.Range("A6").EntireRow.Find("[teacher]", LookIn:=xlValues)
teacher_range.Value = teacher
' Filtering data
data.Range("B1:D" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).AutoFilter Field:=3, Criteria1:=teacher
' Copying Data
Dim data_range As Range
Set data_range = data.Range("B2:C" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
If Not data_range Is Nothing Then
' Copy the first 14 rows to the output worksheet
If data_range.Rows.Count > 14 Then
data_range.Resize(14).Offset(1, 0).Copy Destination:=output.Range("B8")
' Copy the remaining rows to a new worksheet
Dim remaining_data_range As Range
Set remaining_data_range = data_range.Resize(data_range.Rows.Count - 14).Offset(15, 0)
template.Copy After:=Worksheets(Worksheets.Count)
Set output_remain = ActiveSheet
output_remain.Name = teacher & "_2"
remaining_data_range.Copy Destination:=ActiveSheet.Range("B8")
Dim teacher_range_remain As Range
Set teacher_range_remain = output_remain.Range("A6").EntireRow.Find("[teacher]", LookIn:=xlValues)
teacher_range_remain.Value = teacher
Else
data_range.Offset(1, 0).Copy Destination:=output.Range("B8")
End If
End If
' delete filter
data.AutoFilterMode = False
Next teacher
End Sub
Why My first row doesnt get copied as well? And is there any way to automate this code?
' Getting Teacher's Names
Dim teachers_range As Variant
teachers_range = teacher_list.Range("A2:A5")
So anyone know where did Abigail Taylor went?
>! Toilet maybe? :/
Here is the GDrive Link for the EXCEL FILES
答案1
得分: 1
1 可配置/动态教师列表
一种快速而简单的解决方案是查找工作表中的最后一行,然后执行 Range("A2:A" & lastRow)
。
你已经在这里执行了类似的操作:
' 过滤数据
data.Range("B1:D" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).AutoFilter Field:=3, Criteria1:=teacher
你只需要对相同的思路进行适当的调整:
teachers_range = teacher_list.Range("A2:A" & teacher_list.Cells(teacher_list.Rows.Count, "A").End(xlUp).Row) ' 有自动化这一步的想法吗?
替代方法
个人而言,每当我处理事物列表(即"配置")时,我总是使用Excel表格,因为我发现它们比简单的电子表格范围更容易使用,因为你可以直观地看到表格内部和外部的内容。创建表格之后(选择范围,插入表格),你可以使用 ThisWorkbook.Worksheets("工作表名称").ListObjects("表格名称")
来访问它们。
2 缺失的行
最简单的解决方案是,不要从第2行开始(然后稍后进行偏移),而是从第3行开始。
Set data_range = data.Range("B3:C" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
' ... 不要偏移
data_range.Resize(14).Copy Destination:=output.Range("B8")
' ... 不要偏移
data_range.Copy Destination:=output.Range("B8")
为什么呢?
data_range
实际上是一个范围的集合,注意它包括了 B2:C2 和 B14:C23;当你进行偏移时,它变成了 B3:C3 和 B15:C24。
?data_range.Address
$B$2:$C$2,$B$14:$C$23
?data_range.Offset(1,0).Address
$B$3:$C$3,$B$15:$C$24
你之所以使用 offset
是为了尝试去除 B2:C2,但实际上它并没有这样做,它只是将 B2:C2 变成了 B3:C3(B3:C3 被筛选掉,所以它不会被复制)。B14:C23 需要保持原样,但它被更改为 B15:C24(B24:C24 被筛选掉,所以它不会被复制);最终你实际上只复制了 B15:C23,这不是你想要的。
英文:
1 Configurable / dynamic teacher list
The quick and dirty solution is to find the last row in that worksheet, and do Range("A2:A" & lastRow)
.
You already do this here:
' Filtering data
data.Range("B1:D" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).AutoFilter Field:=3, Criteria1:=teacher
You just need to adapt that same idea:
teachers_range = teacher_list.Range("A2:A" & teacher_list.Cells(teacher_list.Rows.Count, "A").End(xlUp).Row) 'Any idea how to automate this?
Alternative
Personally, whenever I deal with a list of things (i.e. "configuration") I always use an Excel Table, as I find them easier to work with than simple spreadsheet ranges, because you can see visually what's inside the table and what's outside the table. After you've created the table (select range, Insert Table) you can access them using ThisWorkbook.Worksheets("WorksheetName").ListObjects("TableName")
.
2 Missing row
The simplest solution is instead of starting from row 2 (and then offsetting later), you simply start from row 3.
Set data_range = data.Range("B3:C" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
' ... don't offset
data_range.Resize(14).Copy Destination:=output.Range("B8")
' ... don't offset
data_range.Copy Destination:=output.Range("B8")
Why?
data_range
is actually a collection of ranges, notice that there's a B2:C2 and a B14:C23; when you offset it, it becomes B3:C3 and B15:C24.
?data_range.Address
$B$2:$C$2,$B$14:$C$23
?data_range.Offset(1,0).Address
$B$3:$C$3,$B$15:$C$24
You're using offset
to try to remove B2:C2 but it's actually not doing that, it's just changing the B2:C2 to B3:C3 (B3:C3 is filtered out so it doesn't get copied). B14:C23 needs to stay as it is, but it's being changed to B15:C24 (B24:C24 is filtered out so it doesn't get copied); what you end up with is actually just B15:C23 being copied, which is not what you want.
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论