Я новичок в VBA и не могу правильно записать данные на новый лист - PullRequest
0 голосов
/ 14 октября 2019

Я новичок в кодировании VBA, и мне нужно создать модуль, который записывает данные на лист, выбранный пользователем, и, если лист не существует, код должен его создать. Проблема в том, что мой код заменяет данные только тогда, когда лист уже существует.

Sub cadastro()

    Dim prod As String
    Dim qtu As Long
    Dim dia As Long
    Dim mes As Long
    Dim ano As Long
    Dim data As String
    Dim ctrl As Boolean
    Dim ultlincad As Long
    Dim ultlinres As Long
    Dim ctrl2 As Boolean
    Dim plan As Worksheet
    Dim i As Integer

    i = 6
    ctrl2 = True
    ctrl = True
    ultlincad = Planilha10.Range("b1048576").End(xlUp).Row


    prod = Application.InputBox("Produto", Title:="Produto MUDAR", Type:=2)
    qtu = Application.InputBox("Quantidade", Title:="Quatidade MUDAR", Type:=1)
    dia = Application.InputBox("Dia", Title:="DIA MUDAR", Type:=1)
    mes = Application.InputBox("Mês", Title:="MES MUDAR", Type:=1)
    ano = Application.InputBox("Ano", Title:="ANO MUDAR", Type:=1)
    data = dia & "/" & mes & "/" & ano
    Planilha10.Cells(ultlincad + 1, 4) = data
    Planilha10.Cells(ultlincad + 1, 4).HorizontalAlignment = xlCenter
    Planilha10.Cells(ultlincad + 1, 4).VerticalAlignment = xlCenter
    Planilha10.Cells(ultlincad + 1, 3) = qtu
    Planilha10.Cells(ultlincad + 1, 3).HorizontalAlignment = xlCenter
    Planilha10.Cells(ultlincad + 1, 3).VerticalAlignment = xlCenter
    Planilha10.Cells(ultlincad + 1, 2) = prod
    Planilha10.Cells(ultlincad + 1, 2).HorizontalAlignment = xlCenter
    Planilha10.Cells(ultlincad + 1, 2).VerticalAlignment = xlCenter


    For Each Sheet In ActiveWorkbook.Worksheets
        ultlinres = Sheet.Range("b1048576").End(xlUp).Row
        If Sheet.Name = ano Then
            Do Until i = (ultlinres + 1)
                Debug.Print ("passo5")
                If Sheet.Cells(i, 2).Value = prod Then
                    Sheet.Cells(i, mes + 2).Value = Sheet.Cells(i, mes + 2).Value + qtu
                    Sheet.Cells(i, mes + 2).HorizontalAlignment = xlCenter
                    Sheet.Cells(i, mes + 2).VerticalAlignment = xlCenter
                    ctrl2 = False
                    ctrl = False
                End If
                i = i + 1
            Loop
            If ctrl2 Then
                Sheet.Cells(6, 2) = prod
                Sheet.Cells(6, mes + 2).Value = qtu
                ctrl = False
            End If
        End If
    Next Sheet

    If ctrl Then
        Set plan = ActiveWorkbook.Sheets.Add
        plan.Name = ano
        plan.Cells(6, 2) = prod
        plan.Cells(6, mes + 2).Value = qtu
    End If

End Sub

1 Ответ

0 голосов
/ 14 октября 2019

Несмотря на то, что я не смог протестировать код, потому что вы не включили некоторые примеры данных, и неясно все шаги, которые вы должны выполнить, вы должны начать.

Посмотрите, как я организовалпошагово, переименовали переменные и реорганизовали (переупорядочили) некоторые части, чтобы сделать его более понятным.

Примечание: этот код является безусловно оптимальным / эффективным, но поскольку вы новичок в изучении VBA, вы можетеначать следовать некоторым хорошим практикам.

Option Explicit

Sub cadastro()

    ' Define Objects
    Dim plan As Worksheet

    ' Define other variables
    Dim prod As String
    Dim qtu As Long

    Dim dia As Long
    Dim mes As Long
    Dim ano As Long

    Dim data As String

    Dim sheetExists As Boolean

    Dim rowCounter As Long
    Dim lastRowCad As Long
    Dim lastRowRes As Long



    ' Initialize variables
    rowCounter = 6 ' Initial row where search begins
    lastRowCad = Planilha10.Range("b1048576").End(xlUp).Row

    ' Gather user input
    prod = Application.InputBox("Produto", Title:="Produto MUDAR", Type:=2)
    qtu = Application.InputBox("Quantidade", Title:="Quatidade MUDAR", Type:=1)
    dia = Application.InputBox("Dia", Title:="DIA MUDAR", Type:=1)
    mes = Application.InputBox("Mês", Title:="MES MUDAR", Type:=1)
    ano = Application.InputBox("Ano", Title:="ANO MUDAR", Type:=1)


    ' Add new row in planilha10
    data = dia & "/" & mes & "/" & ano
    With Planilha10
        .Cells(lastRowCad + 1, 4) = data
        .Cells(lastRowCad + 1, 4).HorizontalAlignment = xlCenter
        .Cells(lastRowCad + 1, 4).VerticalAlignment = xlCenter

        .Cells(lastRowCad + 1, 3) = qtu
        .Cells(lastRowCad + 1, 3).HorizontalAlignment = xlCenter
        .Cells(lastRowCad + 1, 3).VerticalAlignment = xlCenter

        .Cells(lastRowCad + 1, 2) = prod
        .Cells(lastRowCad + 1, 2).HorizontalAlignment = xlCenter
        .Cells(lastRowCad + 1, 2).VerticalAlignment = xlCenter
    End With

    ' Validate if sheet exists
    sheetExists = Evaluate("ISREF('" & ano & "'!A1)")

    If sheetExists = False Then
        Set plan = ThisWorkbook.Worksheets.Add
        ' Set the row where you're gonna store the data
        lastRowRes = 6
    Else
        Set plan = ThisWorkbook.Worksheets(CStr(ano))
        ' Set the row where you're gonna store the data
        With plan
            lastRowRes = .Range("b1048576").End(xlUp).Row ' This seems as if the sheet exists, the named range has to be added previously
            ' Search for product in range
            Do Until rowCounter = (lastRowRes + 1)
                If .Cells(rowCounter, 2).Value = prod Then
                    .Cells(rowCounter, mes + 2).Value = .Cells(rowCounter, mes + 2).Value + qtu
                End If
                rowCounter = rowCounter + 1
            Loop
        End With
    End If

    ' Record data
    With plan
        .Cells(lastRowRes, 2) = prod
        .Cells(lastRowRes, mes + 2).Value = qtu
        .Cells(lastRowRes, mes + 2).HorizontalAlignment = xlCenter
        .Cells(lastRowRes, mes + 2).VerticalAlignment = xlCenter
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...