Вопрос по excel/vba

[sergey_wckd]

не работает...

[sergey_wckd]

Друзья, помогите пожалуйста с этим кодом в нём ошибка!сегодня надо дать какой-то ответ, а то останусь без работы, придётся расстасться с машиной
мечты и коллекторы сразу возьмут меня.очень надеюсь на вас.

[EducatedFool]

Друзья, помогите пожалуйста с этим кодом в нём ошибка!

не работает...

Пока будет подобное описание ошибки, никто Вам не поможет.

Неужели сложно описать в подробностях, что именно не работает (и как должно работать)?

придётся расстасться с машиной мечты

Машина - не главное в жизни.
А если останетесь на этой работе, все задачи будете решать с помощью форума?

и коллекторы сразу возьмут меня

Звучит ужасающе )))

[sergey_wckd]

Описаник ошибки:
Ошибка 13
type mismath



Public Sub zapsuk()
Dim i As Integer, j As Integer, k As Integer, j1 As Integer, j2 As Integer
Dim sm As Double
Dim st As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh1 = ThisWorkbook.Worksheets("Лист1")
Set sh2 = ThisWorkbook.Worksheets("Лист2")
Set sh3 = ThisWorkbook.Worksheets("Лист3")
j = sh1.Cells(Rows.Count, "A").End(xlUp).Row
j1 = sh2.Cells(Rows.Count, "A").End(xlUp).Row
j2 = sh3.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To j
st = Trim(Str(sh1.Range("a" & i)))
For k = 1 To j1
If Trim(Str(sh2.Range("a" & k))) = st Then
sh1.Range("c" & i) = CDbl(Str(sh2.Range("c" & i)) - CDbl(Str(sh1.Range("c" & k))))
sh2.Range("d" & k) = 1
sh1.Range("d" & i) = 1
End If
Next k
Next i
For i = 1 To j
If Not sh1.Range("d" & i) = 1 Then
sh3.Range("a" & j1 + 1) = sh1.Range("a" & i)
sh3.Range("b" & j1 + 1) = sh1.Range("b" & i)
sh3.Range("c" & j1 + 1) = sh1.Range("c" & i)
j = j - 1
sh1.Rows(i).Delete
i = i - 1
End If
Next i
For i = 1 To j1
If Not sh1.Range("d" & i) = 1 Then
sh3.Range("a" & j1 + 1) = sh2.Range("a" & i)
sh3.Range("b" & j1 + 1) = sh2.Range("b" & i)
sh3.Range("c" & j1 + 1) = sh2.Range("c" & i)
j = j - 1
sh1.Rows(i).Delete
i = i - 1
End If
Next i

End Sub

Машина - не главное в жизни.
А если останетесь на этой работе, все задачи будете решать с помощью форума?

Нет мне нужно решить, только эту конкретную задачу.

Звучит ужасающе )))

да))

[EducatedFool]

Вот в таком виде макрос работает:

Sub auto_open()
    zapsuk
End Sub


Public Sub zapsuk()
    Dim i As Integer, j As Integer, k As Integer, j1 As Integer, j2 As Integer
    Dim sm As Double
    Dim st As String
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Set sh1 = ThisWorkbook.Worksheets("Лист1")  ' название первого листа
    Set sh2 = ThisWorkbook.Worksheets("Лист2")    ' название второго листа
    Set sh3 = ThisWorkbook.Worksheets("Лист3")    ' название третьего листа
    j = sh1.Cells(Rows.Count, "A").End(xlUp).Row
    j1 = sh2.Cells(Rows.Count, "A").End(xlUp).Row
    j2 = sh3.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To j
        st = Trim(sh1.Range("a" & i))
        For k = 1 To j1
            If Trim(sh2.Range("a" & k)) = st Then
                sh1.Range("c" & i) = CDbl(sh2.Range("c" & i)) - CDbl(sh1.Range("c" & k))
                sh2.Range("d" & k) = 1
                sh1.Range("d" & i) = 1
            End If
        Next k
    Next i
    For i = 1 To j
        If Not sh1.Range("d" & i) = 1 Then
            sh3.Range("a" & j1 + 1) = sh1.Range("a" & i)
            sh3.Range("b" & j1 + 1) = sh1.Range("b" & i)
            sh3.Range("c" & j1 + 1) = sh1.Range("c" & i)
            j = j - 1
            sh1.Rows(i).Delete
            i = i - 1
        End If
    Next i
    For i = 1 To j1
        If Not sh1.Range("d" & i) = 1 Then
            sh3.Range("a" & j1 + 1) = sh2.Range("a" & i)
            sh3.Range("b" & j1 + 1) = sh2.Range("b" & i)
            sh3.Range("c" & j1 + 1) = sh2.Range("c" & i)
            j = j - 1
            sh1.Rows(i).Delete
            i = i - 1
        End If
    Next i
End Sub

Правда, работает ОЧЕНЬ долго, и непонятно что делает, но работает.
Убрал из кода вызывавшие ошибки функции Str()

Проверяйте:


Могу сделать гораздо более быстрый макрос, но не бесплатно.

[sergey_wckd]

ну спасибо, работает)
жаль, что делает не то, что надо