VBA复制具有特定值的行和列标题

时间:2015-11-27 06:07:59

标签: excel vba excel-vba

我是Visual Basic的新手,我有以下格式的Excel工作表,如下图所示。

Excel Format

我需要编写一个VB代码来创建一个电子表格,格式如下图所示。应为每个具有行和列值的国家/地区打印型号名称' 1'在excel表中。换句话说,只需要打印具有值' 1'的模型名称和国家/地区名称。在电子表格中。如果单元格为空或值为' 0' 0那么我们不需要打印该特定国家的型号名称。

Final Format

我该如何解决?我一直在观看视频,但无济于事。

任何人都可以告诉我该怎么做?任何形式的帮助将不胜感激。提前谢谢。

已编辑:使用以下代码后的当前输出位于此屏幕截图中

Output

1 个答案:

答案 0 :(得分:2)

这应该可以顺利运行,它会在每次运行时创建一个新工作表来显示输出! ;)

Sub test_Dazzler()

Dim wB As Workbook, _
    wBNeW As Workbook, _
    wSSrC As Worksheet, _
    wSDesT As Worksheet, _
    LastRow As Long, _
    LastCol As Integer, _
    WrintingRow As Long, _
    ModeL As String

Set wB = ThisWorkbook
Set wSSrC = wB.ActiveSheet
LastRow = wSSrC.Range("A" & wSSrC.Rows.Count).End(xlUp).Row
LastCol = wSSrC.Range("A1").End(xlToRight).Column
Set wSDesT = wB.Sheets.Add
wSDesT.Cells(1, 1) = "Model": wSDesT.Cells(1, 2) = "Countries"

With wSSrC
    For i = 2 To LastRow
        ModeL = .Range("A" & i).Value
        For j = 2 To LastCol
            If .Cells(i, j) <> 1 Then
            Else
                WrintingRow = wSDesT.Range("A" & wSDesT.Rows.Count).End(xlUp).Row + 1
                wSDesT.Cells(WrintingRow, 1) = ModeL
                wSDesT.Cells(WrintingRow, 2) = .Cells(1, j)
            End If
        Next j
    Next i
    DoEvents
    WsDest.Copy
End With
Set wBNeW = ActiveWorkbook

Dim intChoice As Integer
Dim strPath As String

'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogSaveAs).Show
'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
    If strPath <> False Then wBNeW.SaveAs strPath
    'displays the result in a message box
    Call MsgBox(strPath, vbInformation, "Save Path")
End If

MsgBox "I'm done!"
End Sub