Мне нужна ваша помощь с кодом VBA, который я написал несколько дней назад и который мне не удается заставить его работать.Подводя итог, у меня есть файл «export.prn», из которого мне нужно извлечь данные, чтобы скопировать их в строку в другой файл Excel на конкретном листе.Когда мои данные в строке, я должен скопировать эту строку и перенести ее в столбец на другом листе.Затем в этом столбце (последнем) мне нужно применить формулу ТОЛЬКО к непустым ячейкам (за исключением тех, которые говорят «Uncalib»), чтобы новое значение заменяло старое.Затем для каждой ячейки с формулой (непустые) мне нужно отобразить ее абсолютное значение в ячейке справа (например: C1 = -21; D1 = 21).Наконец, для последнего столбца (с абсолютными значениями) я должен применить правило условного форматирования.Итак, в конце у меня есть 2 столбца (не абсолютный и абсолютный с CF), и ячейки, которые были пустыми в начале, все равно будут пустыми в конце.Кроме того, каждый раз, когда я запускаю этот код, данные должны находиться в следующей строке / столбце, чтобы они не удаляли предыдущие данные (поэтому для каждого цикла будет создаваться 1 строка в столбцах Sheet1 и 2 столбца в Sheet2)
Я очень новичок в 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
````