SERGE_BLIZNUK
Silver Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код:
Sub MoveDataToHex2()
Dim i, j, Row1, Row2, ColumnOfDigit1, ColumnOfDigit2 As Long
Dim ColumnOfMainText, List2Row As Long
Dim Hex2, Mesto As String
Row1 = ActiveSheet.UsedRange.Row
Row2 = Row1 + ActiveSheet.UsedRange.Rows.Count - 1
ColumnOfDigit1 = 1
ColumnOfDigit2 = 2
ColumnOfMainText = 3
List2Row = 1
For i = Row1 To Row2
' проверка на пустоту столбца 2
If IsEmpty(Cells(i, ColumnOfDigit2)) Then
Hex2 = "0000"
Else
If Cells(i, ColumnOfDigit2).Value = 0 Then
Hex2 = "0000"
Else
Hex2 = Hex(Cells(i, ColumnOfDigit2).Value)
End If
End If
' проверка на пустоту местоположения/описания
If IsEmpty(Cells(i, ColumnOfMainText)) Then
Mesto = "0"
Else
Mesto = Cells(i, ColumnOfMainText).Value
End If
For j = 1 To 3
Worksheets("Лист2").Cells(List2Row, 1).Value = _
Hex(Trim(Cells(i, ColumnOfDigit1).Value) & Str(j)) _
& Hex2 & "25099 " & Mesto
List2Row = List2Row + 1
Next j
For j = 5 To 7
Worksheets("Лист2").Cells(List2Row, 1).Value = _
Hex(Trim(Cells(i, ColumnOfDigit1).Value) & Str(j)) _
& Hex2 & "25099 " & Mesto
List2Row = List2Row + 1
Next j
Next i
End Sub
|
|
