MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Distribuir Valores

    Compartilhe

    denisapp
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 20/03/2013

    Distribuir Valores

    Mensagem  denisapp em 10/9/2018, 16:16

    Pessoal, boa tarde! Estou precisando criar uma rotina que pegue um apunhado de valores e divida em 3 arrays da seguinte forma:

    a) Imagine que tenho na tabela os seguintes valores (1 em cada linha): 10; 15; 8; 5; 4; 12; 1; 3; 7; 6
    b) Preciso distribuir estes valores em 3 arrays, sendo que a regra é que o somatório dos valores contidos em cada array seja o mais próximo possível nos três arrays, ou seja, soma(array1)~=soma(array2)~=soma(array3). O ideal seria que o somatório fosse igual nos 3 arrays, mas, nem sempre isso será possível, por isso, aceita-se um somatório próximo.

    Alguém consegue me ajudar?

    Obrigado.

    Ricardo Monteiro
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 46
    Registrado : 27/11/2017

    Re: Distribuir Valores

    Mensagem  Ricardo Monteiro em 11/9/2018, 22:41

    Segue um código que fiz rápido no Excel, ele pega os valores das células em cada linha e distribui em 3 vetores, mas deixa um monte de espaços em cada vetor com o valor zero. Você tem que estudar e adaptá-lo a sua necessidade no access.

    Código:
    Function teste()
        'cria a variável para contar todas as linhas
        Dim linhas As Integer
        linhas = Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Count
        
        'cria os vetores como inteiros e sem dimensão específica
        Dim vetor1() As Integer, vetor2() As Integer, vetor3() As Integer
        
        'redimensiona os vetores para terem tantos espaços quanto o número de linhas
        ReDim vetor1(linhas - 1)
        ReDim vetor2(linhas - 1)
        ReDim vetor3(linhas - 1)
        
        'cria as variáveis de soma
        Dim soma1 As Integer, soma2 As Integer, soma3 As Integer
        soma1 = 0
        soma2 = 0
        soma3 = 0
        
        Dim contador As Integer
        
        
        'no laço de repetição, se o menor valor de soma for soma3, atualiza o valor de soma3 e do vetor3, se for o 2 ou o 1, faz o mesmo respectivamente
        For contador = 0 To linhas - 1
            If soma3 <= soma2 Then
                If soma3 <= soma1 Then
                    vetor3(contador) = Cells(contador + 1, 1).Value
                    soma3 = soma3 + Cells(contador + 1, 1).Value
                Else
                    vetor1(contador) = Cells(contador + 1, 1).Value
                    soma1 = soma1 + Cells(contador + 1, 1).Value
                End If
            Else
                If soma2 <= soma1 Then
                    vetor2(contador) = Cells(contador + 1, 1).Value
                    soma2 = soma2 + Cells(contador + 1, 1).Value
                Else
                    vetor1(contador) = Cells(contador + 1, 1).Value
                    soma1 = soma1 + Cells(contador + 1, 1).Value
                End If
            End If
        Next contador
        'imprime os valores das somas
            Debug.Print soma1
            Debug.Print soma2
            Debug.Print soma3
    End Function

      Data/hora atual: 15/10/2018, 19:50