excel - VBA 的新功能 :)

Question

我需要您对我几天前制作的 VBA 代码的帮助，但我无法使其工作。总而言之，我有一个“export.prn”文件，我需要从中提取数据以将其复制到特定工作表中的另一个 Excel 文件中。当我的数据在一行中时，我必须复制这一行并将其转换为另一张工作表中的一列。然后，在这一列（最后一列）上，我只需要对非空白单元格应用一个公式（除了那些说“Uncalib”的单元格），以便新值替换旧值。然后，对于每个带有公式的单元格（非空白单元格），我需要在右侧的单元格中显示其绝对值（例如：C1=-21；D1=21）。最后，对于最后一列（带有绝对值），我必须应用条件格式规则。所以，最后，我有 2 列（CF 的非绝对和绝对），开始时为空白的单元格最后仍为空白。此外，每次运行此代码时，数据都需要位于下一行/列中，这样它就不会删除以前的数据（因此每次运行都会在 Sheet1 中创建 1 行，在 Sheet2 中创建 2 列）

我是 VBA 的新手，并试图做一些事情，但它似乎不能正常工作，尤其是最后的行： If WsZscore.Cells(i, LastCol).Value = "" Then 而且我不知道为什么（因为我对这类东西的了解有限^^ ）。我的代码对于我想要做的事情来说可能太长了，但我没有设法让它更短：/

谢谢 ：）

Sub TM()

Application.ScreenUpdating = False

Réponse = MsgBox("Voulez vous importer les données ?", vbYesNo)
    If Réponse <> vbYes Then Exit Sub

Dim i As Long
Dim j As Long
Dim l As Long


Dim WsCartes As Worksheet
Dim WsDonnées As Worksheet
Dim WsOrigine As Worksheet

'Set my workbooks and sheets
Set WsCartes = Workbooks("Classeur1.xlsm").Worksheets("cartes")
Set WsDonnées = Workbooks("Classeur1.xlsm").Worksheets("TM")
Set WsOrigine = Workbooks("export2.prn").Worksheets("export2")
Set WsZscore = Workbooks("Classeur1.xlsm").Worksheets("ZscoreTM")


i = 2
l = 4

WsCartes.Range("D5").Value = WsOrigine.Range("J4").Value

'Import my data from the export.prn file
While WsOrigine.Cells(l, 2).Value <> ""

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Be9*" Then

        While (WsDonnées.Range("A" & i).Value <> "")
        i = i + 1
        Wend

        WsDonnées.Range("A" & i).Value = WsOrigine.Range("J4").Value
        WsDonnées.Range("B" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("A" & i).Copy
        WsDonnées.Range("A" & i).PasteSpecial (xlPasteValues)

        WsDonnées.Range("B" & i).Copy
        WsDonnées.Range("B" & i).PasteSpecial (xlPasteValues)

    End If

     If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "B11*" Then

        WsDonnées.Range("C" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("C" & i).Copy
        WsDonnées.Range("C" & i).PasteSpecial (xlPasteValues)

    End If

        If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Al27*" Then

        WsDonnées.Range("D" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("D" & i).Copy
        WsDonnées.Range("D" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Cr52*" Then

        WsDonnées.Range("E" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("E" & i).Copy
        WsDonnées.Range("E" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Mn55*" Then

        WsDonnées.Range("F" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("F" & i).Copy
        WsDonnées.Range("F" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Fe56*" Then

        WsDonnées.Range("G" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("G" & i).Copy
        WsDonnées.Range("G" & i).PasteSpecial (xlPasteValues)
    End If


    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Co59*" Then

        WsDonnées.Range("H" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("H" & i).Copy
        WsDonnées.Range("H" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Ni60*" Then

        WsDonnées.Range("I" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("I" & i).Copy
        WsDonnées.Range("I" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Cu65*" Then

        WsDonnées.Range("J" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("J" & i).Copy
        WsDonnées.Range("J" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Zn66*" Then

        WsDonnées.Range("K" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("K" & i).Copy
        WsDonnées.Range("K" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "As75*" Then

        WsDonnées.Range("L" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("L" & i).Copy
        WsDonnées.Range("L" & i).PasteSpecial (xlPasteValues)

    End If

     If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Mo98*" Then

        WsDonnées.Range("M" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("M" & i).Copy
        WsDonnées.Range("M" & i).PasteSpecial (xlPasteValues)

    End If

       If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Cd114*" Then

        WsDonnées.Range("N" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("N" & i).Copy
        WsDonnées.Range("N" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Sn118*" Then

        WsDonnées.Range("O" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("O" & i).Copy
        WsDonnées.Range("O" & i).PasteSpecial (xlPasteValues)

    End If

      If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Sb121*" Then

        WsDonnées.Range("P" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("P" & i).Copy
        WsDonnées.Range("P" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Ba137*" Then

        WsDonnées.Range("Q" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("Q" & i).Copy
        WsDonnées.Range("Q" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Pb...*" Then

        WsDonnées.Range("R" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("R" & i).Copy
        WsDonnées.Range("R" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "U238*" Then

        WsDonnées.Range("S" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("S" & i).Copy
        WsDonnées.Range("S" & i).PasteSpecial (xlPasteValues)

    End If

    If WsOrigine.Cells(l, 1).Value = "TM-24.4" And WsOrigine.Cells(l, 3).Value = "Se78*" Then

        WsDonnées.Range("T" & i).Value = WsOrigine.Cells(l, 7).Value

        WsDonnées.Range("T" & i).Copy
        WsDonnées.Range("T" & i).PasteSpecial (xlPasteValues)

    End If


    l = l + 1
Wend

'Define the LastRow/LastCol
LastRow = WsDonnées.Cells(Rows.Count, "A").End(xlUp).Row
LastRow2 = WsZscore.Cells(Rows.Count, "A").End(xlUp).Row
LastCol = WsZscore.Cells(3, Columns.Count).End(xlToLeft).Column

'Copy the last row from Sheet1 and transpose it to the last empty column in Sheet2
WsDonnées.Cells(LastRow, 1).EntireRow.Copy
WsZscore.Cells(2, LastCol + 1).PasteSpecial Transpose:=True

'If a cell display Uncalib, display nothing
For i = 3 To LastRow2
If WsZscore.Cells(i, LastCol + 1).Value = "Uncalib" Then
    WsZscore.Cells(i, LastCol + 1).Value = ""
End If
Next i

'Apply the formula to the values expect for the blank ones
LastCol = WsZscore.Cells(3, Columns.Count).End(xlToLeft).Column
For i = 3 To LastRow2
If WsZscore.Cells(i, LastCol).Value = "" Then
    WsZscore.Cells(i, LastCol + 1).Value = ""
    Else
        WsZscore.Cells(i, LastCol + 1).Formula = "=(RC[-1]-RC2)/(RC3/2)"
End If
Next i


LastCol = WsZscore.Cells(3, Columns.Count).End(xlToLeft).Column
WsZscore.Cells(2, LastCol).EntireColumn.Copy
WsZscore.Cells(2, LastCol - 1).EntireColumn.PasteSpecial xlPasteValues
WsZscore.Cells(2, LastCol).EntireColumn.Delete


'Apply the absolute formula to the non-empty cells and display the result in the cell to the right
LastCol = WsZscore.Cells(3, Columns.Count).End(xlToLeft).Column
For i = 3 To LastRow2
WsZscore.Cells(i, LastCol + 1).Formula = "=ABS(RC[-1])"
WsZscore.Cells(i, LastCol + 1).Value = WsZscore.Cells(i, LastCol + 1).Value


'Set my conditional formatting rules
Set iset = WsZscore.Cells(i, LastCol + 1).FormatConditions.AddIconSetCondition
'select the traffic lights iconset
With iset
    .IconSet = ActiveWorkbook.IconSets(xl3Symbols)
    .ReverseOrder = True
    .ShowIconOnly = True
End With
'specify amber traffic light for values >= 80% of target(2500)
With iset.IconCriteria(2)
    .Type = xlConditionValueNumber
    .Operator = xlGreaterEqual
    .Value = "=2"
End With
'specify green traffic light for values >= the target(2500)
With iset.IconCriteria(3)
    .Type = xlConditionValueNumber
    .Operator = xlGreaterEqual
    .Value = "=3"
End With

WsZscore.Cells(i, LastCol).NumberFormat = "0.00"

Next i

'Display nothing and delete CF if the cell is blank
For i = 3 To LastRow2
If WsZscore.Cells(i, LastCol).Value = "" Then
    WsZscore.Cells(i, LastCol + 1).FormatConditions.Delete
    WsZscore.Cells(i, LastCol + 1).Value = ""

End If
Next i

WsZscore.Cells(2, LastCol).Value = WsDonnées.Cells(LastRow, 1).Value
WsZscore.Cells(2, LastCol).Font.Bold = True


Application.ScreenUpdating = True

 End Sub
````

标签： excelvba