I need to reformat a 33500 row of data in excel. I am trying to write a macro that would do this for me.
I have put some nested loop to solve the issue
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim K As Integer
Dim p As Integer
Dim c As Integer
For c = 0 To 10
For n = 5 To 10
K = 14 + 7 * (n - 5)
For i = 0 To 7
m = 14 + 8 * c
ActiveSheet.Cells(m + i, n).Select
Selection.Copy
ActiveSheet.Cells(K + i, 37).Select
ActiveSheet.Paste
Next i
Next n
Next c
I am stuck at how to get this operation done for 32500 rows
Excel's Integer has a range of values from -32,768 to 32,767 so formatting 33,500 rows might be a problem. Assuming that you are happy with how your code works, changing your variable types to Long might be a good start.
BTW, you should avoid SELECTing cells as it slows down the code and can lead to errors. You can easily copy and paste between cells using soemthing like
Cells(m + i, n).Copy Destination:=Cells(K + i, 37)
Revised the code according to the comment and now working like a charm. Thank you so much
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim K As Integer
Dim p As Integer
For i = 0 To 121
m = 14
For n = 5 To 35
ActiveSheet.Range(Cells(m + i * 8, n), Cells(m + i * 8 + 7, n)).Copy
Range("AK" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
Next n
Next i
End Sub
Related
as far as I concern, it is permissible in VBA to do the calculation larger than 15 digits which giving you no zeroes automatically after the fifteenth digit -> more accuracy.
The idea is, the calculation could be done in VBA. The wished result(1,07007000700007000007654321) can be presented in excel as a string data type through format conversion(it is just to show in Excel sheet not to be calculated)
Question:
1 + 0.07007000700007000007654321
-> Excel gives 1.07007000700007000008
Expectation: 1.07007000700007000007654321
Here are my codes:
Sub test()
Dim y As Double
Dim m As String
'cell(1,1) is where 0.07007000700007000007654321
y = 1 + Cells(1, 1)
m = CStr(y)
Cells(2, 1).Value = m
End Sub
Thanks for the time and knowledge, guys!
Use Decimal - which needs a variable declared as Variant:
Dim y As Variant
Dim m As String
'cell(1,1) is where 0.07007000700007000007654321
y = 1 + CDec(Cells(1, 1))
m = CStr(y)
' m -> "1.07007000700007000007654321"
I have to fill about 2k rows in excel which would hurt my brain to do it manually... But after 4hours of searching and trying to solve this problem I'm really close to give it up.
Here is a simple example: A101.0 which is used as a code for a position. The .0 is going to .0 to .6, then the 01 should increase by 1 to look like A102.0 and so on. The 01 which is before the . is going to 57 so the last would look like A157.6. And after this the number near the A should go up to 2, like this. A201.0 and starting over the cycle again.
The very last should looks like this: A657.6
So A is fix, first number is going 1 to 6, the 2 next to it is going 01 to 57 for every "1 to 6" and the last number after the dot is going 0 to 6 for every "01 to 57" number.
I wrote a little macro but not working so well...
Sub Makro1()
Dim i As Integer
Dim j As Integer
Dim k As Integer
For k = 1 To 6
For j = 1 To 57
For i = 1 To 7
Munka1.Cells(i * j * k, 10).Value = "A" & k & j & i - 1
Next i
Next j
Next k
End Sub
If there is any solution whithout vba it would be good also.
I think your macro is fine, it's just this: i * j * k that is bad. Multiplying those numbers together is not going to give you an integer that corresponds to an excel row. Instead you'll need one more variable to track the row to which you write the incremented value:
Sub Makro1()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim writeRow as Integer
writeRow = 1
For k = 1 To 6
For j = 1 To 57
For i = 1 To 7
Munka1.Cells(writeRow, 10).Value = "A" & k & j & "." & i - 1
writeRow = writeRow + 1
Next i
Next j
Next k
End Sub
Updated to add: I also stuck a & "." & in there to include the decimal in your outputted string location value.
If you have Excel O365 with the SEQUENCE function, you can enter, in a single cell, the formula:
=TEXT((INT(SEQUENCE(6*57*7,,0)/(57*7))+1)*100+(MOD(INT(SEQUENCE(6*57*7,,1,1/7))-1,57)+1)+MOD( SEQUENCE(6*57*7,,0),7)/10,"A000.0")
and it will spill down to create the series you describe.
I think this will give you what you want. Stringing numbers together the way you are is going to cause problems when k jumps from 9 to 10 as the k string is now 2 digits:
You can build the number numerically instead and then force it into a format of your choosing:
Sub Makro1()
Dim i As Long, j As Long, k As Long, y As Long
y = 1 ' y is used as the writing pointer
For k = 1 To 6
For j = 1 To 57
For i = 0 To 6
Munka1.Cells(y, 10).Value = "A" & Format((k * 100) + j + (i / 10), "000.0")
y = y + 1
Next i
Next j
Next k
End Sub
Finally, if you really wanted to concatenate your numbers instead of using math(s), you could use:
Munka1.Cells(y, 10).Value = "A" & k & Right("0" & j, 2) & "." & i
"If there is any solution whithout vba it would be good also."
Instead of VBA, you could use the following formula in A1 and drag down:
=IF(ROUNDUP(ROW()/399,0)>6,"","A"&ROUNDUP(ROW()/399,0)&TEXT(MOD(ROUNDUP(ROW()/7,0)-1,57)+1,"00")&"."&MOD(ROW(A1)-1,7))
I stuck the IF in there to start showing blanks after A657.6 or rather, row 2395.
can anyone please do this example for me i`m stuck here for about 2 days and cant do it :(
I need to make a code which will write numbers in this pyramidal way: 1 121 12321 1234321.. and must be written as example at this picture
Try this in a worksheet code
Public Sub MakePyramid()
Dim r_start As Range
Set r_start = Range("A1")
Dim i As Long, j As Long, n As Long
n = 3 ' Number of layers
For i = 1 To n
For j = 1 To i
r_start.Cells(2 * i - j, j).Value = j
r_start.Cells(j, 2 * i - j).Value = j
Next j
Next i
End Sub
Result
But why?
You need to figure out why this code works in order to prepare for your exam.
In Excel, we have 3 columns with values in them Length, Width, and Height of objects. Each row stands for 1 object, now we need to find the X number of objects that fit the most together.
For Example:
Now let's say we need the 2 closest sets of values, the output should give Nbr. 1 and 2 because [abs(11-10) + abs(9-8) + abs(4-5)] is the smallest value you'll get. Here we needed to find the 2 closest but sometimes we need to find the 25 closest sets of values.
Moreover, some might find Height not important or really important so you may want to lower or heighten its importance by adding in factors F(1,2,3) with which you multiply a part of the formula:
[F1 * abs(11-10) + F2 * abs(9-8) + F3 * abs(4-5)]
I tried to find the first (second, third and so on) smallest difference in value which works for just one variable but not multiple ones at the same time with:
=INDEX(A$2:A$5002,MATCH(SMALL(ABS(B$2:B$5002-B2),2),ABS(B$2:B$5002-B2),0))
I don´t know an Excel formula to solve this problem as I want to find the X nearest combination of values.
I expect a result showing the row numbers of X objects that fit the best together.
I Created a VBA Excel code that seems to work pretty nice in finding out which value combinations fit best together. It shows the closest values and the sum of all differences to determine the combination that works best. I did remove the first row of the picture in the description though. If anyone can improve, please do.
Sub test()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim L As Integer
Dim W As Integer
Dim H As Integer
Dim AantalGelijken As Integer
Dim FL As Integer
Dim FW As Integer
Dim FH As Integer
FL = 1
FW = 1
FH = 0.8
AantalGelijken = InputBox("How many comparable sets do you need", "Number")
L = 2
W = 3
H = 4
For i = 1 To last_row
For j = 1 To last_row
If i <> j Then
Cells(j, 5).Value = FL * Abs(Cells(i, L) - Cells(j, L)) + FW * Abs(Cells(i, W) - Cells(j, W)) + FH * Abs(Cells(i, H) - Cells(j, H))
End If
Next j
For k = 1 To AantalGelijken
Cells(i, 5 + k) = WorksheetFunction.Index(Range("A1:A9999"), WorksheetFunction.Match(WorksheetFunction.Small(Range("E1:E9999"), k), Range("E1:E9999"), 0))
Cells(i, AantalGelijken + 6) = Cells(i, AantalGelijken + 6) + WorksheetFunction.Small(Range("E1:E9999"), k)
Next k
Range("E1:E9999").Clear
Next i
End Sub
`
I have data stored in some column (Say, Column A). The length of Column A is not fixed (depends on previous steps in the code).
I need a histogram for the values in Column A, and have it in the same sheet. I need to take the values in column A, and automatically compute M Bins, then give the plot.
I looked online for a "simple" code, but all codes are really fancy, with tons of details that I don't need, to the extent that I am not even able to use it. (I am a VBA beginner.)
I found the following code that seems to do the job, but I am having trouble even calling the function. Besides, it only does computations but does not make the plot.
Sub Hist(M As Long, arr() As Single)
Dim i As Long, j As Long
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Single
For i = 1 To M
freq(i) = 0
Next i
Length = (arr(UBound(arr)) - arr(1)) / M
For i = 1 To M
breaks(i) = arr(1) + Length * i
Next i
For i = 1 To UBound(arr)
If (arr(i) <= breaks(1)) Then freq(1) = freq(1) + 1
If (arr(i) >= breaks(M - 1)) Then freq(M) = freq(M) + 1
For j = 2 To M - 1
If (arr(i) > breaks(j - 1) And arr(i) <= breaks(j)) Then freq(j) = freq(j) + 1
Next j
Next i
For i = 1 To M
Cells(i, 1) = breaks(i)
Cells(i, 2) = freq(i)
Next i
End Sub
And then I try to call it simply by:
Sub TestTrial()
Dim arr() As Variant
Dim M As Double
Dim N As Range
arr = Range("A1:A10").Value
M = 10
Hist(M, arr) ' This does not work. Gives me Error (= Expected)
End Sub
A little late but still I want to share my solution. I created a Histogram function which might be used as array formula in the excel spread sheet. Note: you must press
CTRL+SHIFT+ENTER to enter the formula into your workbook. Input is the range of values and the number M of bins for the histogram. The output range must have M rows and two columns. One column for the bin value and one column for the bin frequency.
Option Explicit
Option Base 1
Public Function Histogram(arr As Range, M As Long) As Variant
On Error GoTo ErrHandler
Dim val() As Variant
val = arr.Value
Dim i As Long, j As Integer
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Integer
Dim min As Single
min = WorksheetFunction.min(val)
Dim max As Single
max = WorksheetFunction.max(val)
Length = (max - min) / M
For i = 1 To M
breaks(i) = min + Length * i
freq(i) = 0
Next i
For i = 1 To UBound(val)
If IsNumeric(val(i, 1)) And Not IsEmpty(val(i, 1)) Then
If val(i, 1) > breaks(M) Then
freq(M) = freq(M) + 1
Else
j = Int((val(i, 1) - min) / Length) + 1
freq(j) = freq(j) + 1
End If
End If
Next i
Dim res() As Variant
ReDim res(M, 2)
For i = 1 To M
res(i, 1) = breaks(i)
res(i, 2) = freq(i)
Next i
Histogram = res
ErrHandler:
'Debug.Print Err.Description
End Function
Not 100% sure as to the efficacy of that approach but;
Remove the parens as your calling a sub; Hist M, arr
M is declared as double but received by the function as a long; this won't work so declare it in the calling routine as long
You will need to recieve arr() As Variant
Range -> Array produces a 2 dimensional array so the elements are arr(1, 1) .. arr(n, 1)