Question

我是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

Answer 1

即使我因为您没有包括一些示例数据而无法测试代码，也不清楚您必须遵循的所有步骤，但这应该会让您入门。

看看我如何组织步骤，重命名变量并重构（重新排序）某些部分，以使其更加清晰。

注意：该代码到目前为止是最佳/高效的，但是当您不熟悉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

我是VBA的新手，无法在新工作表中正确写入数据

1 个答案: