遍历Excel的特定单元格并使用VB代码导出

时间:2018-12-23 10:10:20

标签: c# vb.net excel-vba

我下面附有一张Excel表格作为驱动器链接。我需要一个C#或vb代码,它将读取excel,仅在excel表中选择每个学生的卷号(即301)和喜欢的科目(即数学),并导出到其他Excel(在A和B列中),例如:< / p>

301   Maths
302   English
303   Science
... and so on.

请注意,我必须选择的记录是从第200行开始的。其余部分都不需要选择。

我有这样的代码,它仅获取Harry的数据。其他学生也需要。

Dim appXL As Excel.Application
Dim wbXL As Excel.Workbook
Dim wbsXL As Excel.Workbooks
Dim shXL As Excel.Worksheet
Dim Checker, Checker1 As Integer
appXL = CreateObject("excel.application")
appXL.Visible = True
wbsXL = appXL.Workbooks
wbXL = wbsXL.Open("C:\Users\Pashupati\Desktop\excel.xlsx")
shXL = wbXL.ActiveSheet
Dim rng, rng1 As Excel.Range
rng = CType(shXL.Cells(200, 3), Excel.Range)
rng1 = CType(shXL.Cells(208, 1), Excel.Range)
Checker = rng.Value.ToString()
Checker1 = rng1.Value.ToString()
End Sub()

将感谢您的配合。

Click here to view source Excel File

1 个答案:

答案 0 :(得分:0)

Sub macro1()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim xrow As Long, q As Long


Set ws1 = Workbooks("StudentData").Worksheets("Sheet1")
Set ws2 = Workbooks("NewWorkbook").Worksheets("Sheet1")

ws2.Cells(1, 2).Value = "Favourite Subjects"
ws2.Cells(1, 1).Value = "Roll no."
xrow = 2

For x = 200 To 300
    If ws1.Cells(x, 1).Value = "Favourite Subjects" Then
        q = x + 1
        ws1.Cells(q, 1).Value = ws2.Cells(xrow, 2).Value
        xrow = xrow + 1
    Else:
    End If
Next x

xrow = 2

For y = 200 To 300
    If ws1.Cells(y, 2).Value = "Roll no." Then
         ws1.Cells(y, 3).Value = ws2.Cells(y, 1).Value
         xrow = xrow + 1
    Else:
    End If
Next y

End Sub

只需更改工作簿和工作表的名称,即可完成工作。如果遇到错误,则可能是使用ws1和ws2的语法,因为excel不喜欢在工作簿之间传输数据。您可以通过将代码更改为以下内容来解决此问题:

Sub macro1()
Dim xrow As Long, q As Long

xrow = 2

For x = 200 To 300
    If Cells(x, 1).Value = "Favourite Subjects" Then
        q = x + 1
        Cells(q, 1).Value = Cells(xrow, 6).Value
        xrow = xrow + 1
    Else:
    End If
Next x

xrow = 2

For y = 200 To 300
    If Cells(y, 2).Value = "Roll no." Then
         Cells(y, 3).Value = Cells(y, 5).Value
         xrow = xrow + 1
    Else:
    End If
Next y

End Sub

然后复制D和E列并将其粘贴到新的WB中。