Moderatori: Anthony47, Flash30005
Serve semplicemente una macro. Ma rileggendo posso dirti che sono conteggi per risolvere Sudoku Killer. Aggiungo a me serve una macro non un risolutore di Sudoku killer.
Rispo = cArr(1)
cArr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 4, 27, 60, 61, 79, 78, 32, 80, 82, 73, 77, 79, 32, 65, 80, 82, 73, 76, 69)
cArr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 4, 27, 60, 61, 79, 78, 32, 80, 82, 73, 77, 79, 32, 65, 80, 82, 73, 76, 69)
Rispo = cArr(1)
Anthony47 ha scritto:Vedo che la macro che risolve da sola non e' stata apprezzata... pazienza, sara' per l'anno prossimo...
Sub SetMixxx(ByRef Root As Range)
Dim TB3 As Worksheet, mySplit, iCnt As Long, gRow As Long
Dim gColC As String, GoGo As Boolean, GoNo As Boolean
Dim eTBSomma As Long, eTBCelle As Long, eTBYes As Long, eTBNo As Long
Dim JJ As Long, J As Long
'
Set TB3 = ThisWorkbook.Sheets("Tabella3")
'
On Error Resume Next
eTBYes = Root.Offset(-2, 0).Value
eTBNo = Root.Offset(-1, 0).Value
eTBSomma = Root.Offset(-3, 0).Value
eTBCelle = Root.Offset(-3, 1).Value
On Error GoTo 0
'
gRow = Evaluate("=Max((Tabella3!A1:A200=" & eTBSomma & ")*(Tabella3!B1:B200=" & eTBCelle & ")*(Row(Tabella3!1:200)))")
If gRow > 0 And gRow < 200 Then
Root.Resize(12, 10).ClearContents
Root.Resize(12, 10).Interior.Color = xlNone
mySplit = Split(TB3.Cells(gRow, "C").Value & " ", " ", , vbTextCompare)
iCnt = UBound(mySplit)
gColC = TB3.Cells(gRow, "C").Value
For I = 0 To UBound(mySplit)
If eTBYes <> 0 Then GoGo = False Else GoGo = True
GoNo = False
citm = mySplit(I)
For J = 1 To Len(citm)
If InStr(1, "0" & eTBYes, Mid(citm, J, 1), vbTextCompare) > 0 Then
GoGo = True
ElseIf InStr(1, "0" & eTBNo, Mid(citm, J, 1), vbTextCompare) > 0 Then
GoNo = True
End If
Next J
If GoGo And GoNo = False Then
JJ = JJ + 1
For J = 1 To Len(citm)
If Mid(citm, J, 1) <> " " Then
Root.Cells(JJ + 0, J).Value = CInt(Mid(citm, J, 1))
End If
Next J
Else
End If
Next I
Root.Resize(JJ, eTBCelle).Interior.Color = RGB(200, 250, 200)
Else
Root.Resize(12, 9).Interior.Color = RGB(255, 200, 200)
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myC As Range, I As Long, RRan As String
'
For Each myC In Target
For I = 0 To 3
If UCase(myC.Offset(-I, 0).Value) = "NUM" Then
RRan = myC.Offset(-I + 4, 0).Address
Exit For
ElseIf UCase(myC.Offset(-I, 0).Value) = "CELLE" Then
RRan = myC.Offset(-1 + 4, -1).Address
Exit For
End If
If myC.Offset(-I, 0).Row < 2 Then Exit Sub
Next I
If I < 4 Then
Application.EnableEvents = False
Call SetMixxx(Range(RRan))
Application.EnableEvents = True
End If
Next myC
End Sub
Anthony47 ha scritto:.
Vuoi quindi i dati su foglio Excel...
Torna a Applicazioni Office Windows
formattare una colonnacon numeri senza virgolaSalve Autore: giorgioa |
Forum: Applicazioni Office Windows Risposte: 5 |
Come nascondere I Numeri non Appartenenti Al Mese Deside Autore: Maury170419 |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: Nessuno e 19 ospiti