I have a list of products with the ID and the picture name. One entry per picture, instead of one entry per product and the pictures in columns as I need it. If the file had only a few entries, the manual procedure I guess it would be to cut all the picture names for the same product, paste (transpose) and remove the entries without names. But since the file has over 100,000 entries, does anyone know how to do this using VBA?
EXAMPLE:
What I have...
product_id; picture_name
1; picture1.jpg
1; picture2.jpg
1; picture3.jpg
2; picture4.jpg
3; picture5.jpg
3; picture6.jpg
What I need...
product_id; 1st_picture; 2nd_picture; 3rd_picture...
1; picture1.jpg; picture2.jpg; picture3.jpg
2; picture4.jpg
3; picture5.jpg; picture6.jpg
Thank so you much in advance for your help.
I guess this solves your problem
Compare two consecutive rows one by one
If two rows matches,Take the corresponding value in 2nd column of 2nd row put the value in next to 2nd column of 1st row and delete the 2nd row
If not matches skip the previous step and go for comparison of next two rows.
Here is the Code
Sub SortPics()
i = 2
Do
Flag = False
VarComp1 = Sheets("YourSheetName").Cells(i, 1).Value
VarComp2 = Sheets("YourSheetName").Cells(i + 1, 1).Value
If VarComp1 = VarComp2 And VarComp2 <> "" Then
Set VarSec1 = Sheets("YourSheetName").Cells(i, 2)
Set VarSec2 = Sheets("YourSheetName").Cells(i + 1, 2)
VarSec1.Offset(0, 1 + j).Value = VarSec2.Value
Sheets("YourSheetName").Cells(i + 1, 1).EntireRow.Delete
i = i - 1
Flag = True
End If
i = i + 1
If Flag = True Then
j = j + 1
Else
j = 0
End If
Loop While VarComp1 <> ""
End Sub
Related
I cannot extract the postal/zip code of a given address cell that comes like this :
"108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS".
I have used :
=RECHERCHE(9^9;--("0"&STXT(A2;MIN(CHERCHE({0.1.2.3.4.5.6.7.8.9};A2&"0 123456789"));LIGNE($1:$100))))
Which sometimes works, sometimes not depending on the street number starting the address (here "108,").
The problem is the space of the pattern "37 170". I would like to remove the blank space in the pattern. Is there a regex way to search this pattern "## ###", and then to remove this poisonous blank space?
Thank you for your tricks.
I have tried this piece of code :
Function toto(r, Optional u = 0)
Application.Volatile
Dim i%, j%, adr$, cp$, loca$, x
x = Split(r)
For i = 0 To UBound(x)
If x(i) Like "#####" Then Exit For
Next
If i > UBound(x) Then
adr = r.Value 'facultatif
Else
cp = x(i)
For j = 0 To i - 1: adr = adr & x(j) & " ": Next
adr = Left$(adr, Len(adr) + (Len(adr) > 1))
For j = i + 1 To UBound(x): loca = loca & x(j) & " ": Next
loca = Left$(loca, Len(loca) + (Len(loca) > 1))
End If
x = Array(adr, cp, loca)
If 0 < u And u < 4 Then toto = x(u - 1) Else toto = x
End Function
The above code works fine for splitting addresses including street number, zip code, and city name. But it does not work when the zip code is ## ### = 2 digit integer - space - 3 digit integer.
Edit: 01 June 2021
Since it seems my question is not clear enough, let's rephrase :
Given an Excel worksheet containing in each cell of column A, from saying A1 down to A10000, complete addresses like this one :
"2 rue Rene cassin Centre Commercial Châlon 2 Sud 71 100 CHALON SUR SAONE"
or this one :
"15, Rue Emile Schwoerer 68 000 COLMAR"
Where "71 100" and "68 000" are a zip code in incorrect format because of the extra space between the 2 first digits and 3 last digits.
I need to split the Ai cell content in order to obtain :
in cell Bi : the text (street, etc.) placed left before the 2 first digits of the "wrong" zip code,
in cell Ci : the zip code with its correct format ("71100" and not "71 100"),
in cell Di : the text (city name) after the zip code.
It's a kind of left and right extraction around the zip code.
The above code that I have posted does not work.
In order to obtain the correct zip code format, I have tried the regex following function :
Function FindReplaceRegex(rng As Range, reg_exp As String, replace As String)
Set myRegExp = New RegExp
myRegExp.IgnoreCase = False
myRegExp.Global = True
myRegExp.Pattern = reg_exp
FindReplaceRegex = myRegExp.replace(rng.Value, replace)
End Function
But I am unable to determine the correct regular expression pattern to get rid of the space in the zip code.
PEH gave me the following pattern :
(.*)([0-9]{2} ?[0-9]{3})(.*)
When using the function, I have tried to define the replacement pattern by:
(.*)([0-9]{2}[0-9]{3})(.*)
But it would not work. Hope this will clarify my question.
Any idea is welcome. Thanks
If these input strings always have the same pattern, try:
=CONCAT(FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[.*0=0]"))
Depending on your needs/edge-cases, you could add more xpath expressions.
If this is VBA, I have a fix for you (please forgive the crappy naming convention, I'm scribbling this down in work while waiting for SQL to refresh):
Sub test1()
a0 = Cells(1, 1) 'Get the text, in this case "108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS"
aa = Replace(a0, ",", " ") 'Make all delimiters of same type, so removing commas, you may need to add more replace work here?
ab = Application.Trim(aa) 'Reduce all whitespace to single entries, i.e. " " rather than " "
ac = Split(ab, " ", -1) 'Now split by that single whitespace entry
Dim txt()
i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1 'Step through each entry in our "split" list
If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then
'Two numbers back to back, join
ReDim Preserve txt(i2)
txt(i2) = ac(i1) + ac(i1 + 1)
i2 = i2 + 1
i1 = i1 + 1
Else
'Not two numbers back to back, don't join
ReDim Preserve txt(i2)
txt(i2) = ac(i1)
i2 = i2 + 1
End If
Next i1
If IsNumeric(ac(UBound(ac))) = False Then
'Need to add last entry to txt()
ReDim Preserve txt(UBound(txt) + 1)
txt(UBound(txt)) = ac(UBound(ac))
End If
End Sub
edit 2021-06-01:
The above will generate a list (txt) of all the entries within your address. You can then reassemble if you wish, or extract out the postcode only.
If you want it as a function, then it would be:
Public Function getPostcode(a0)
aa = Replace(a0, ",", " ")
ab = Application.Trim(aa)
ac = Split(ab, " ", -1)
Dim txt()
i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1
If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then
'Two numbers back to back, join
ReDim Preserve txt(i2)
txt(i2) = ac(i1) + ac(i1 + 1)
i2 = i2 + 1
i1 = i1 + 1
Else
'Not two numbers back to back, don't join
ReDim Preserve txt(i2)
txt(i2) = ac(i1)
i2 = i2 + 1
End If
Next i1
If IsNumeric(ac(UBound(ac))) = False Then
'Need to add last entry to txt()
ReDim Preserve txt(UBound(txt) + 1)
txt(UBound(txt)) = ac(UBound(ac))
End If
'Re-assemble string for return
rtnTxt = ""
For i1 = 0 To UBound(txt)
rtnTxt = rtnTxt & " " & txt(i1)
Next i1
getPostcode = rtnTxt
End Function
The program requires input of positive numbers, and counts each even number using a loop function that doesn't count odds and ends if a O is input.
I'm not sure how to go about creating a loop or if I can use an if function within the loop.
Dim Count = 0
While (number mod 2 = 0) do
Count + 1 = Count
I actually didn't understand the question very well but as far as concerned, if you dont want odd numbers to be included I suggest on count add 2 not one , since the count variable starts with zero do:
Dim Count+2
Btw when do you want the count to stop? At 2 And goes back to 0?
If so then use the if statement
var Dim_count = 0;
if(Dim_count == 0){Dim_count+2}
else if(Dim_count ==2){Dim_Count =0;}
It would help if you provide a sample input so we can work with actual code and guide you to the right solution.
If you receive the input as, let's say, array of numbers, you can simply loop trough it using for or foreach and add additional condition to check for 0 if you want to preliminary exit:
For Each number As Integer In numbers
If (number mod 2 = 0) Then
Count = Count + 1
End If
If (number = 0) Then
Exit For
End If
Next
If you have existing code in which somehow number is reinitialized/redefined on each iteration already, then what you have is pretty close to what you need:
While (number <> 0)
If (number mod 2 = 0) Then
Count = Count + 1
End If
End While
Function counts even numbers:
REM function gets input, exits at 0 and adds positive even numbers.
DO
INPUT X
IF X = 0 THEN PRINT Y; " even numbers": END
IF X > 0 THEN
IF X / 2 = X \ 2 THEN Y = Y + 1
END IF
LOOP
I am completely unsure about this. just a guess...
Dim j as Integer
Dim i As integer
j = 0
i = 2
For i = 1 to 100
j = j+i
Print j
Loop
End Sub
Assuming you are getting numbers from some input, this is how you can do it. Have an infinite loop with While True, then for every number given from your input, check if its even using number mod 2 = 0. This will go on forever so you need to add some condition (another if statement) for it to stop the while loop. More information about while loops here: https://learn.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/while-end-while-statement
Dim Count = 0
While True do
If (number mod 2 = 0) Then
Count + 1 = Count
End If
End While
I have designed a while loop in Matlab to do a specific task. Firstly, I am importing the titles of several columns of an excel spreadsheet.
'student #' ' assn1' ' assn2' ' assn3' ' assn4' ' assn5' ' lab1' ' lab2' ' lab3' ' lab4' ' midterm' ' final exam'
These are stored in a matrix called 'txt'. While my counter variable 'i' has not reached the numerical value equal to the size of 'txt', enter the loop. I store the current value of the vector in the variable j.If the first 4 letters of this value are equal to "assn", increase the assignmentCounter by 1. If it is not, do nothing. Then, before exiting the loop, increase the counter variable 'i' by 1. Ideally, this program should tell me how many times an assn appears in the matrix 'txt'. However, my end result is that the assignmentCounter is 0. I do not know what to do. Any help would be greatly appreciated, thanks!
Code:
%Assignment 4
clear;
clc;
filename = 'marksdata.xlsx';
[num, txt, raw] = xlsread(filename);
%Loop through the categories
assignmentCounter = 0;
categorySize = size(txt);
i = 1;
loopCount = 0;
while i < categorySize
j = txt(i, categorySize);
if strncmpi('assn',j, 4)
assignmentCounter = assignmentCounter + 1;
end
i = i + 1;
end
Ideally, this program should tell me how many times an assn appears in
the matrix 'txt'.
If that is all what you want, this why not:
txt={'student #' ' assn1' ' assn2' ' assn3' ' assn4' ' assn5' ' lab1' ' lab2' ' lab3' ' lab4' ' midterm' ' final exam'}
c=strfind(txt,'assn');
sum(~cellfun(#isempty,c))
% 5
so assn shows up 5 times.
Alright what did I do wrong? Found this on the web, tried it and got a type mismatch. Just trying to make my code more concise by having the variables define themselves, for e.g. Y(10), Y(11), Y(12), Y(13), or Y10 ... Y13, so I'll have 4 variables at the end of the sub. Y10-13 are NOT the cell positions, but they are related. Look Below!
variable a refers to the actual row, so say Y10 = 400 is the only entry on row 5, row 7 has Y10 = 7 and Y12 = 3. I did not define this in the code because this section runs as function(a) and a is defined before the function itself such that the sub checks for a=1 to the last row.
Dim Y(10 To 13) As Integer 'these are just variables
Dim a as long 'this is an arbitrary row number defined before the function
For I = 10 to 13 'These are column numbers in the actual data range
If .Worksheets("15SK").Cells(a, I) <> "" Then
Y(I) = .Worksheets("15SK").Cells(a, I).value 'Y(I) basically takes the value of the cell (a,I)
End If
Next
I basically need a dynamic variable Y(I) or YI (in any form really) because later sections of my code calls for it. I'll share another section to state my point, but its difficult for me to translate what I'm doing in this next section:
For I = 10 To .Worksheets("15SK").Cells(2, Columns.Count).End(xlToLeft).Column 'All models
If .Worksheets("15SK").Cells(a, I) <> "" Then 'If product model order > 0
'removed a section of code here
j = j + 3 'step 3
If ItemType = "Adaptor" And Y > X1 And DUP <> 1 Then
Y1 = Y1 + Y(I)
If ItemType = "Adaptor" And Y1 > X1 Then 'adding another duplicate
DOwb.Worksheets(1).Cells(j, 3) = .Worksheets("15SK").Cells(2, I) 'First DO product model row
DOwb.Worksheets(1).Cells(j - 1, 1) = Y1 - X1 'Excess Qty to be charged
DOwb.Worksheets(1).Cells(j - 3 - 1, 1) = Y(I) - (Y1 - X1) 'Making the previous row's Qty FOC by no. of CD - no. of previous
DOwb.Worksheets(1).Cells(j - 1, 2) = "pcs"
DOwb.Worksheets(1).Cells(j - 1, 3) = Application.WorksheetFunction.VLookup(DOwb.Worksheets(1).Cells(j, 3), .Worksheets("Catalogue").Range("catalogue"), 2, False) 'Model Description
JFOC = j
j = j + 3 'step 3
DUP = 1 'stops the duplication
ElseIf Y1 = X1 Then
JFOC = j
End If
Y1 = 0
End If
Sorry guys really new to VBA, or coding for the matter. Terrific help so far!
Y10 cannot be the name of variable (because it could be confused with cell Y10). Code that attempts to use such variable names will not work. Try other name, for example y_10 will be fine.
Well i am completely stuck in reading an excel sheet(beginner with python)....I have 3 columns in an excel sheet say (A, B and C) with n number of rows in each of them ....so how can i possibly create a loop which iterates over all the rows till it reaches the end and write the content in a text file(.txt)....number of rows being same for all 3 columns....help please
code I'm using to open up the excel sheet is :
import xlrd
workbook = xlrd.open_workbook('Book1.xlsx')
worksheet = workbook.sheet_by_name('Sheet1')
Code used:
num_rows = worksheet.nrows - 1
num_cells = worksheet.ncols - 1
curr_row = -1
while curr_row < num_rows:
curr_row += 1
row = worksheet.row(curr_row)
curr_cell = -1
while curr_cell < num_cells:
curr_cell += 1
cell_value = worksheet.cell_value(curr_row, curr_cell)
print (cell_value)
Code follows your code will be:
textfile=open(filenameOfTextFile, 'w')
rows=sheet.nrows
for row in range(rows):
textfile.write(sheet.cell(row,0).value + "," + sheet.cell(row,1).value + "," + sheet.cell(row,2).value + "\n")