I am working in this project where I have to compare the value of an array with itself so I have used 2 2D arrays having the same size and values where I used one for comparing while making changes to the other the problem is that when I make changes to one the other also changes.
is there any way I can assign the value of any 2D arrays without having them changing together.
what I have used is the simple vb.net assignment:
x=y and it works fine only for that one issue.
I haven't completed the code yet that's what I have for now.
xgame = game
For i As Integer = 0 To n - 1
For j As Integer = 0 To n - 1
If (j = 0 And i = 0) Then
If xgame(i, j + 1) = "1" Then
count = count + 1
End If
If xgame(i + 1, j) = "1" Then
count = count + 1
End If
If xgame(i + 1, j + 1) = "1" Then
count = count + 1
End If
If count <= 1 Then
game(i, j) = "-"
End If
ElseIf (i = 0 And ((j > 0) Or (j < n - 1))) Then
count = 0
If xgame(i, j - 1) = "1" Then
count = count + 1
End If
If xgame(i, j + 1) = "1" Then
count = count + 1
End If
If xgame(i + 1, j - 1) = "1" Then
count = count + 1
End If
If xgame(i + 1, j) = "1" Then
count = count + 1
End If
If xgame(i + 1, j + 1) = "1" Then
count = count + 1
End If
If (count < 2 Or count > 3) Then
game(i, j) = "-"
ElseIf (count = 3) Then
game(i, j) = "1"
End If
ElseIf (i = 0 And j = n - 1) Then
End If
Next
Next
Related
NumberFormat seems to be a straightforward function but I can't get it to work is a rather simple case. In the code below VBA tells me "Type Mismatch".
For j = 1 To last_column + 1
For f = 2 To total_tranches + 1
If allocation(f - 1, j - 1) = Empty And j <> 1 Then
Allo1.Cells(AlShares.Row - 1 + f, j + 1) = 0
Else
Allo1.Cells(AlShares.Row - 1 + f, j + 1) = allocation(f - 1, j - 1)
If j = 1 Then Allo1.Cells(AlShares.Row - 1 + f, j + 1).IndentLevel = 1
If j = 2 Then Allo1.Cells(AlShares.Row - 1 + f, j + 1).NumberFormat = "_($*#,##0_);_($*(#,##0);_($*" - "??_);_(#_)"
End If
Next f
Next j
And if I replace specific formatting with "Accounting" it just does not work. Please help!
You are asking VBA to subtract 2 strings "...($*" - "??_.." so that is the type mismatch.
I have a for loop that takes a user's input and one of the keys in my dictionary and passes them to a Damerau-Levenshtein function and based on the distance, overwrites the user's input with the dictionary key (The for loop is to cycle through each dictionary key). This works fine enough for strings larger than three characters, but if the string is three or fewer characters the algorithm returns with the wrong key. Here's the for loop:
1950 For j = 0 To dict.Count - 1
1960 distance = DamerauLevenshtein(SplitStr(i), dict.Keys(j))
1970 'MsgBox dict.Keys(j) & vbCrLf & distance ' used for debugging
1980 If distance < 4 Then
1990 If distance < leastDist Then
2000 leastDist = distance
2010 SplitStr(i) = dict.Keys(j)
2020 End If
2030 End If
2040 Next
2050 MsgBox "The distance is: " & leastDist & vbCrLf & "The entered text was " & tempStr & vbCrLf & "The replaced word is " & SplitStr(i)
SplitStr(i) holds the user's input, which comes from a split function. I arbitrarily picked 4 for a good distance
I stole the algorithm from a bytes.com forum post. Algorithm below:
Function DamerauLevenshtein(str1, str2, Optional intSize = 256)
Dim intTotalLen, arrDistance, intLen1, intLen2, i, j, arrStr1, arrStr2, arrDA, intMini
Dim intDB, intI1, intJ1, intD
str1 = UCase(str1)
str2 = UCase(str2)
intLen1 = Len(str1)
intLen2 = Len(str2)
intTotalLen = intLen1 + intLen2
ReDim arrStr1(intLen1)
ReDim arrStr2(intLen2)
ReDim arrDA(intSize)
ReDim arrDistance(intLen1 + 2, intLen2 + 2)
arrDistance(0, 0) = intTotalLen
For i = 0 To intSize - 1
arrDA(i) = 0
Next
For i = 0 To intLen1
arrDistance(i + 1, 1) = i
arrDistance(i + 1, 0) = intTotalLen
Next
For i = 1 To intLen1
arrStr1(i - 1) = Asc(Mid(str1, i, 1))
Next
For j = 0 To intLen2
arrDistance(1, j + 1) = j
arrDistance(0, j + 1) = intTotalLen
Next
For j = 1 To intLen2
arrStr2(j - 1) = Asc(Mid(str2, j, 1))
Next
For i = 1 To intLen1
intDB = 0
For j = 1 To intLen2
intI1 = arrDA(arrStr2(j - 1))
intJ1 = intDB
If arrStr1(i - 1) = arrStr2(j - 1) Then
intD = 0
Else
intD = 1
End If
If intD = 0 Then intDB = j
intMini = arrDistance(i, j) + intD
If intMini > arrDistance(i + 1, j) + 1 Then intMini = arrDistance(i + 1, j) + 1
If intMini > arrDistance(i, j + 1) + 1 Then intMini = arrDistance(i, j + 1) + 1
If intMini > arrDistance(intI1, intJ1) + i - intI1 + j - intJ1 - 1 Then intMini = arrDistance(intI1, intJ1) + i - intI1 + j - intJ1 - 1
arrDistance(i + 1, j + 1) = intMini
Next
arrDA(arrStr1(i - 1)) = i
Next
DamerauLevenshtein = arrDistance(intLen1 + 1, intLen2 + 1)
End Function
If I type in "Cire" the algorithm correctly returns "CORE".
"Raman" returns "REMAN"
"Cosnigned" returns "CONSIGNED
However, "Now" should return "New" but returns "OCM".
"New" also returns "OCM" (so distance should be 0, but is 2.)
"FP" should be "FP" but returns "OCM", distance is 2
"DPF" Should be "DPF" but returns "OCM", distance is 2
I just learned about the algorithm, so I'm sure I'm missing something important, but I just can't see it. Thoughts?
I figured it out. After much searching I found a post saying that an edit distance is commonly 2. (They didn't specify any merits on why 2 is common)
I switched my if statement to 2 from 4 and now all of the problem terms are being corrected as they should be.
I'm having trouble with the same task that I have to do in four different ways (the four do loops, basically), and it is to generate random numbers and sort them to even and odd. I have specific instructions that this has to be done using do while and do until loops, and so far I've managed to do only one of the four.
The first problem is in the fact that the loop here won't run because nch = ch already and it checks the condition first. Is there a way to get around this? The exit conditions are no more than 290 iterations or nch = ch.
Cells.Clear
Randomize
ch = 0
nch = 0
Worksheets("sheet2").Cells(1, 1) = "Do..Until Loop"
Worksheets("sheet2").Cells(1, 2) = "Even"
Worksheets("sheet2").Cells(1, 3) = "Odd"
Do Until (nch + ch) = 290 Or nch = ch
n = Fix((31 - 13 + 1) * Rnd) + 13
If n Mod 2 = 0 Then
ch = ch + 1
Worksheets("sheet2").Cells(1 + ch, 2) = n
Else
nch = nch + 1
Worksheets("sheet2").Cells(1 + nch, 3) = n
End If
Loop
The second problem is with a do while loop, where I have to achieve the same goal, but the first condition keeps being ignored for some reason.
Do
If n Mod 2 = 0 Then
ch = ch + 1
Worksheets("sheet2").Cells(1 + ch, 2) = n
Else
nch = nch + 1
Worksheets("sheet2").Cells(1 + nch, 3) = n
End If
Loop While (nch + ch) < 290 Or nch <> ch
Any help would be much appreciated! Thanks!
Not sure if you have to write it as 'Loop While' for your home work.
but you could change your syntax to.
Do While (nch + ch) < 290
n = Fix((31 - 13 + 1) * Rnd) + 13
If n Mod 2 = 0 Then
ch = ch + 1
Worksheets("sheet2").Cells(1 + ch, 2) = n
Else
nch = nch + 1
Worksheets("sheet2").Cells(1 + nch, 3) = n
End If
Loop
And your I'm not sure your 'Do Until' needs the second check, try this:
Cells.Clear
Randomize
ch = 0
nch = 0
Worksheets("sheet2").Cells(1, 1) = "Do..Until Loop"
Worksheets("sheet2").Cells(1, 2) = "Even"
Worksheets("sheet2").Cells(1, 3) = "Odd"
Cells.Clear
Randomize
ch = 0
nch = 0
Worksheets("sheet2").Cells(1, 1) = "Do..Until Loop"
Worksheets("sheet2").Cells(1, 2) = "Even"
Worksheets("sheet2").Cells(1, 3) = "Odd"
Do Until (nch + ch) = 290
n = Fix((31 - 13 + 1) * Rnd) + 13
If n Mod 2 = 0 Then
ch = ch + 1
Worksheets("sheet2").Cells(1 + ch, 2) = n
Else
nch = nch + 1
Worksheets("sheet2").Cells(1 + nch, 3) = n
End If
Loop
Also its not the cleanest way but to check a criteria later on you can use this to exit the loop.
If ch = nch Then
Exit Do
End If
If you add a boolean to evaluate it
Cells.Clear
Randomize
ch = 0
nch = 0
equal = false
Worksheets("sheet2").Cells(1, 1) = "Do..Until Loop"
Worksheets("sheet2").Cells(1, 2) = "Even"
Worksheets("sheet2").Cells(1, 3) = "Odd"
Do Until (nch + ch) = 290 Or equal
n = Fix((31 - 13 + 1) * Rnd) + 13
If n Mod 2 = 0 Then
ch = ch + 1
Worksheets("sheet2").Cells(1 + ch, 2) = n
Else
nch = nch + 1
Worksheets("sheet2").Cells(1 + nch, 3) = n
End If
If nch = ch Then
equal = true
End If
Loop
With the second example where is n defined? if n=0 the n Mod 2 will equal 0
"until" stops if true, "while" stops when false.
not ( (nch + ch) = 290 Or nch = ch )
is
(nch + ch) <> 290 AND nch <> ch
the "or" is likely to be your problem.
Please keep in mind the two codes are not totally equivalent, as in the second, the loop is executed at least once.
For j = 1 To 8
Sheet5.Cells(j + 1, 2) = 480
Next
t = 0
c = 0
For j = LBound(arrayTime) + 1 To UBound(arrayTime)
MsgBox "j " & j
'MsgBox (t)
numMins = Sheet5.Cells((j + 1) - (8 * c), 2) - arrayTime(j)
If numMins < 0 Then
t = t + 1
ReDim Preserve arrayTime(numrows - 1 + t)
arrayTime(numrows - 1 + t) = arrayTime(j)
MsgBox (arrayTime(numrows - 1 + t))
Else
Sheet5.Cells((j + 1) - (8 * c), 2) = numMins
End If
If j = 8 * (c + 1) Then
c = c + 1
End If
MsgBox ("end " & t)
Next
Im trying to add an value to arrayTime if the condition is true. I successfully added it but the for loop will not re-dimension to loop through the added element. The array originally contains 12 elements then I add a 13th but the loop does to recognize the 13th element and only loops 12 times. Any suggestions on how to get the for loop to loop 13 times?
Add a loop counter, say i, and set it to LBound(arrayTime) + 1 then use a Do Until (i = UBound(arrayTime)). This forces VBA to recalculate the upper bound before each loop.
In excel, I have column 1 with tickers, and column 2 with numbers, like this:
A B
1 AAA 10
2 AAA 12
3 AAA 14
4 BBB 9
5 BBB 10
6 BBB 11
I need a piece of code to calculate average BY TICKER, which means that in this case I would have AAA average : 12 and BBB average = 10, etc etc etc. Up to now all i got is this code which tries to calculate the sums, I will do the divisions later, but something's wrong:
For row = 2 to 6
Ticker = Cells(row - 1, 1)
If Cells(row, 1) = Cells(row - 1, 1) Then
sum = sum + Cells(row, 2)
Else
Cells(row, 6) = sum
sum = 0
row = row + 1
Next
I get an error saying "For is missing"
Maybe something like this in C1.
=IF(A1<>A2,AVERAGEIF(A:A,A1,B:B),"")
In your code:
sum ignored the first AAA
missed the End If
incremented row twice, once by row = row+1 and then by next
and some other not used variables
Try this:
Prev = "***"
For row = 1 to 6
If Cells(row, 1) = prev Then
sum = sum + Cells(row, 2)
Else
Cells(row, 6) = sum
sum = 0
End If
prev = Cells(row,1)
Next
To extend the answer from Jeeped and do it with a list which is not ordered, you also could do it like this:
C1: =A1
C2: =IF(LEN(C1),IFERROR(INDEX(A:A,MATCH(1,(COUNTIF(C$1:C1,A$1:A$1000)=0)*(A$1:A$1000<>""),0)),""),"")}
C3....Cn: copy down from C2
D1: =IF(LEN(C1),AVERAGEIF(A:A,C1,B:B),"")
D2...Dn: copy down from D1
C2 is an array formula and needs to be confirmed with Ctrl+Shift+Enter
to do it via VBA (should be faster than my formula for really big tables) you can use something like that: (put this in a "Module" in the VBA-Window, the same like your recorded macros ar written)
Option Explicit
Public Function getAllAvg(rng As Range) As Variant
Set rng = Intersect(rng.Parent.UsedRange, rng)
Dim varInput As Variant
varInput = rng.Value
Dim varOutput() As Variant
ReDim varOutput(1 To UBound(varInput), 1 To 2)
varOutput(1, 1) = ""
Dim i As Long, j As Long
For i = 1 To UBound(varInput)
If Len(varInput(i, 1)) Then
j = 1
While Len(varOutput(j, 1)) And (varOutput(j, 1) <> varInput(i, 1)) And (j < UBound(varOutput))
j = j + 1
Wend
If Len(varOutput(j, 1)) = 0 Then
varOutput(j, 1) = varInput(i, 1)
varOutput(j, 2) = Application.AverageIf(rng.Columns(1), varOutput(j, 1), rng.Columns(2))
varOutput(j + 1, 1) = ""
End If
End If
Next
While Len(varOutput(j, 1)) And (j < UBound(varOutput))
j = j + 1
Wend
If Len(varOutput(j, 1)) = 0 Then
For i = j To UBound(varOutput)
varOutput(i, 1) = ""
varOutput(i, 2) = ""
Next
End If
getAllAvg = varOutput
End Function
then select a range like C2:D12 and enter:
=getAllAvg(A:B)
and confirm with Ctrl+Shift+Enter. it will directly output the whole list (and recalculate if needed)
EDIT:
If your list is always in a sorted order, you also could use this code:
Option Explicit
Public Function getAllAvgSorted(rng As Range) As Variant
Set rng = Intersect(rng.Parent.UsedRange, rng)
Dim varInput As Variant
varInput = rng.Value
Dim varOutput() As Variant
ReDim varOutput(1 To UBound(varInput), 1 To 2)
varOutput(1, 1) = ""
Dim i As Long, j As Long
j = 1
For i = 1 To UBound(varInput)
If Len(varInput(i, 1)) Then
If varOutput(j, 1) <> varInput(i, 1) Then
If Len(varOutput(j, 1)) Then j = j + 1
varOutput(j, 1) = varInput(i, 1)
varOutput(j, 2) = Application.AverageIf(rng.Columns(1), varOutput(j, 1), rng.Columns(2))
End If
End If
Next
While j < UBound(varOutput)
j = j + 1
varOutput(j, 1) = ""
varOutput(j, 2) = ""
Wend
getAllAvgSorted = varOutput
End Function