Macro para identificar/separar dezenas presentes e ausentes numa seleção.

[Wata]

Acho que fiquei mais de 1h no chatgpt, tentando criar uma macro para utilizar nos meus estudos das loterias.

 

Spoiler

Sub IdentificarPresentesEAusentes()
    Dim rng As Range
    Dim minVal As Double
    Dim maxVal As Double
    Dim missingVals As Collection
    Dim i As Double
    Dim startRow As Long
    Dim nextRow As Long
    Dim colIndex As Integer
    Dim colOffset As Integer
    
    ' Defina a seleção onde deseja aplicar a macro
    Set rng = Selection
    
    ' Armazene o índice da coluna atual
    colIndex = rng.Column

    ' Encontre o menor e o maior valor na seleção
    minVal = WorksheetFunction.Min(rng)
    maxVal = WorksheetFunction.Max(rng)

    ' Crie uma coleção para armazenar os números faltantes
    Set missingVals = New Collection

    ' Preencha a coleção com os números faltantes entre o menor e o maior valor
    For i = minVal To maxVal
        On Error Resume Next
        missingVals.Add i, CStr(i)
        On Error GoTo 0
    Next i

    ' Classifique a coleção para obter os valores únicos em ordem crescente
    Call SortCollection(missingVals)

    ' Insira os valores únicos na primeira linha da coluna após a seleção
    startRow = rng.Row
    nextRow = rng.Rows.count + startRow + 1
    colOffset = rng.Columns.count
    For i = 1 To missingVals.count
        rng.Worksheet.Cells(startRow, colIndex + i + colOffset).Value = missingVals.Item(i)
    Next i

    ' Insira os valores que estão faltando entre o menor e o maior valor logo abaixo da linha onde estão todas as dezenas
    Dim count As Integer
    count = 1
    For i = minVal To maxVal
        If WorksheetFunction.CountIf(rng, i) = 0 Then
            rng.Worksheet.Cells(startRow + 1, colIndex + count + colOffset).Value = i
            count = count + 1
        End If
    Next i

    ' Restaurar seleção original
    rng.Worksheet.Cells(startRow, colIndex).Select
End Sub

Sub SortCollection(col As Collection)
    Dim arr() As Variant
    Dim i As Long
    Dim j As Long
    Dim temp As Variant

    ReDim arr(1 To col.count)

    For i = 1 To col.count
        arr(i) = col(i)
    Next i

    For i = 1 To UBound(arr)
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i

    Set col = New Collection ' Crie uma nova coleção

    For i = 1 To UBound(arr)
        col.Add arr(i), CStr(arr(i))
    Next i
End Sub

 

Essa macro identifica e separa todas as dezenas (números decimais inteiros) presentes e ausentes em uma seleção de células numa planilha do Excel.

 

O que mais me impressionou foi o final da conversa...rs......

 

 

 

...

[Guest]

10 minutes ago, Wata said:

Acho que fiquei mais de 1h no chatgpt, tentando criar uma macro para utilizar nos meus estudos das loterias.

 

  Reveal hidden contents

Sub IdentificarPresentesEAusentes()
    Dim rng As Range
    Dim minVal As Double
    Dim maxVal As Double
    Dim missingVals As Collection
    Dim i As Double
    Dim startRow As Long
    Dim nextRow As Long
    Dim colIndex As Integer
    Dim colOffset As Integer
    
    ' Defina a seleção onde deseja aplicar a macro
    Set rng = Selection
    
    ' Armazene o índice da coluna atual
    colIndex = rng.Column

    ' Encontre o menor e o maior valor na seleção
    minVal = WorksheetFunction.Min(rng)
    maxVal = WorksheetFunction.Max(rng)

    ' Crie uma coleção para armazenar os números faltantes
    Set missingVals = New Collection

    ' Preencha a coleção com os números faltantes entre o menor e o maior valor
    For i = minVal To maxVal
        On Error Resume Next
        missingVals.Add i, CStr(i)
        On Error GoTo 0
    Next i

    ' Classifique a coleção para obter os valores únicos em ordem crescente
    Call SortCollection(missingVals)

    ' Insira os valores únicos na primeira linha da coluna após a seleção
    startRow = rng.Row
    nextRow = rng.Rows.count + startRow + 1
    colOffset = rng.Columns.count
    For i = 1 To missingVals.count
        rng.Worksheet.Cells(startRow, colIndex + i + colOffset).Value = missingVals.Item(i)
    Next i

    ' Insira os valores que estão faltando entre o menor e o maior valor logo abaixo da linha onde estão todas as dezenas
    Dim count As Integer
    count = 1
    For i = minVal To maxVal
        If WorksheetFunction.CountIf(rng, i) = 0 Then
            rng.Worksheet.Cells(startRow + 1, colIndex + count + colOffset).Value = i
            count = count + 1
        End If
    Next i

    ' Restaurar seleção original
    rng.Worksheet.Cells(startRow, colIndex).Select
End Sub

Sub SortCollection(col As Collection)
    Dim arr() As Variant
    Dim i As Long
    Dim j As Long
    Dim temp As Variant

    ReDim arr(1 To col.count)

    For i = 1 To col.count
        arr(i) = col(i)
    Next i

    For i = 1 To UBound(arr)
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i

    Set col = New Collection ' Crie uma nova coleção

    For i = 1 To UBound(arr)
        col.Add arr(i), CStr(arr(i))
    Next i
End Sub

 

Essa macro identifica e separa todas as dezenas (números decimais inteiros) presentes e ausentes em uma seleção de células numa planilha do Excel.

 

O que mais me impressionou foi o final da conversa...rs......

 

 

 

...

 

se durante alguma sessão com a menina da IA, ela disser arre égua, já sei onde foi e com quem ela aprendeu tal expressão idiomática !

 

[Wata]

@Eolocos

 

Uma vez eu perguntei se ela guardava as conversas e ela disse que não.

Então eu perguntei como ela aprende se não tem memórias... daí ela me enrolou e não respondeu......

 

...

[Pedepano]

kkk, uma pena que não tirei captura de tela da conversa que tive com ela um dia onde eu disse que eu tinha 4 jogos que garantia lucro, se os 15 números sorteados estivesse entre os 21 no total.

Serio, pensa uma IA que fico pistola comigo, chegou a dizer que eu estava totalmente equivocado, tipo, você não sabe de nada, rsrsr,  e que isso não seria possível. 

Mesmo eu explicando para ela todos os detalhes de como isso era possível, ela não aceitou que isso existia. Questionei ela, ela sendo uma IA com a inteligência que supostamente tem, deveria saber sobre isso, e como fazer isso, já que é tudo matemática. Porem se vc pedir para ela fazer algo para loteria, esquece, ela era, faz calculo errado, e não te entrega algo que funciona. Estranho né, kkk

 

[Guest]

10 hours ago, Wata said:

@Eolocos

 

Uma vez eu perguntei se ela guardava as conversas e ela disse que não.

Então eu perguntei como ela aprende se não tem memórias... daí ela me enrolou e não respondeu......

 

...

 

pois é,

 

a uns 2 meses atrás, perguntei a ela o limite de caracteres que eu poderia colocar no chat para resolver um código e ela me respondeu algo em torno de 4000 caracteres, ou algo próximo disto.

 

depois ao assistir o vídeo de Fábio Akita, entendi o porque ela ter esta limitação.

 

mas, sabemos que a IA, aprende ao longo do processo, não apenas no treinamento.

 

logo, tudo o que conversamos com ela, servirá de base para outras questões, em especial, quando a corrigimos !!

 

e veja só que interessante isto: