all possible combinations - ms-access

i need to get a list of all possible combinations, not permutations.
to make sure i have the right name, 123 and 321 to me are the same thing and should only be listed once.
the code below does what i need but i can't convert it into MS Access vba.
i'm sorry, i know this is basic and it has been asked a million times but i can't find anything for MS Access that works for me.
Sub test_print_nCr()
print_nCr 7, 3, Range("A1")
End Sub
2.
Public Function print_nCr(n As Integer, r As Integer, p As Range)
c = 1
internal_print_nCr n, r, p, 1, 1
End Function
3.
Public Function internal_print_nCr(n As Integer, r As Integer, ByVal p As Range, Optional i As Integer, Optional l As Integer) As Integer
' n is the number of items we are choosing from
' r is the number of items to choose
' p is the upper corner of the output range
' i is the minimum item we are allowed to pick
' l is how many levels we are in to the choosing
' c is the complete set we are working on
If n < 1 Or r > n Or r < 0 Then Err.Raise 1
If i < 1 Then i = 1
If l < 1 Then l = 1
If c < 1 Then c = 1
If r = 0 Then
p = 1
Exit Function
End If
Dim x As Integer
Dim y As Integer
For x = i To n - r + 1
If r = 1 Then
If c > 1 Then
For y = 0 To l - 2
If p.Offset(c - 1, y) = "" Then p.Offset(c - 1, y) = p.Offset(c - 2, y)
Next
End If
p.Offset(c - 1, l - 1) = x
c = c + 1
Else
p.Offset(c - 1, l - 1) = x
internal_print_nCr n, r - 1, p, x + 1, l + 1
End If
Next
End Function
thank you again

I am not sure if this is the best method to do this, but I would use a kind of binary representation. For instance, consider the word "boy" with the number of letters n=3. This word has three letters, so you can use something like this:
001 = y,
010 = o,
011 = oy,
100 = b,
101 = by,
110 = bo,
111 = boy.
The left side can be done with a loop from i=1 to power(2,n)-1 and transforming i to a number in the binary basis. So, the only thing you have to do is to use the non null positions to build your combinations.
Probably there is something more interesting than this in Knuth.

i found this code here, and it gives me exactly what i need. you just have to create a table with numbers from 1-100. instructions at the link below
enter link description here
thank you everyone
Public Sub buildquery(strN As String, K As Integer)
Dim qd As DAO.QueryDef
Dim intI As Integer
Dim strsql As String
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
Set qd = CurrentDb.QueryDefs("QN")
qd.sql = "SELECT N FROM tblN WHERE N IN (" & strN & ")"
Set qd = Nothing
strSelect = "SELECT QN.N "
strFrom = "FROM QN "
strWhere = "WHERE QN_1.N > QN.N "
For intI = 1 To K - 1
strSelect = strSelect & ", QN_" & intI & ".N AS N" & intI & " "
strFrom = strFrom & ", QN AS QN_" & intI & " "
If intI < K - 1 Then
strWhere = strWhere & " AND QN_" & intI + 1 & ".N > QN_" & intI & ".N "
End If
Next
strsql = strSelect & " INTO tblCombinations " & strFrom & strWhere
DoCmd.SetWarnings False
DoCmd.RunSQL strsql
DoCmd.SetWarnings True
End Sub
then test
Public Sub testbuildquery()
buildquery "1,2,3,4,5,6,7", 3
End Sub

Related

how to display long text ( datatype text up to 20 000 characters) in div

I'm currently enhancing a system using vb.net. My issue is, i need to display a column name 'WONOTE' (datatype TEXT) from SQL Server into div in html front screen. The maximum length of characters for this column is up to 22 000 characters. I retrieved the data from SQL server into div by using sql command in code behind. I manage to display the data but only up to 110 characters by using this statement 1:
REPLACE(REPLACE(cast(WONOTE as varchar(110)), CHAR(13), ''), CHAR(10), '')
and up to 10 characters using this statement 2:
CONVERT(VARCHAR(10), b.WONOTE) as WONOTE
but I need it to display full text. If i change into varchar(max) or anything greater than 110 for statement 1 and 10 for statement 2 it display nothing.
I wish someone can help me with it.
Thank you in advance.
How i retrieved data from SQL server:
Public Sub GETWHATSRUNNING()
Dim paraWC As SqlParameter
Dim SQL As String
Dim myArray, myArray1, myArray2, myArray3,
myArray4, myArray5, myArray6, myArray7,
myArray8, myArray9, myArray10 As String
TempDT.Columns.Add("WO", GetType(String))
TempDT.Columns.Add("WOQTY", GetType(String))
TempDT.Columns.Add("PartNum", GetType(String))
TempDT.Columns.Add("Desc", GetType(String))
TempDT.Columns.Add("WIPQTY", GetType(String))
TempDT.Columns.Add("WIPDAYS", GetType(String))
TempDT.Columns.Add("WOAGING", GetType(String))
TempDT.Columns.Add("AGINGATWC", GetType(Double))
TempDT.Columns.Add("COLOR", GetType(String))
'TempDT.Columns.Add("WO_NOTE", GetType(String))
WCLimit = 5
SQL = "select distinct A.WONO, B.BLDQTY , C.PART_NO , C.DESCRIPT, B.Start_Date, REPLACE(REPLACE(cast(WONOTE as varchar(110)), CHAR(13), ''), CHAR(10), '') " & _
"from Transfer A " & _
"left join WOENTRY B on A.wono = B.wono " & _
"left join INVENTOR C on B.UNIQ_KEY = C.UNIQ_KEY " & _
"where FR_DEPT_ID = #WC and start_date is not null " & _
"and B.BLDQTY <> B.COMPLETE "
GetConnection()
oConnSql = New SqlConnection(connString.ToString)
oCmdSql = New SqlCommand(SQL, oConnSql)
paraWC = New SqlParameter("#WC", SqlDbType.VarChar, 5)
paraWC.Value = lblWC.Text
oCmdSql.Parameters.Add(paraWC)
oCmdSql.CommandTimeout = 7200
Try
If oConnSql.State = ConnectionState.Closed Then
oConnSql.Open()
End If
' Adapter and Dataset
oAdptSql.SelectCommand = oCmdSql
oAdptSql.Fill(oDS, "dtList")
oAdptSql.Fill(dt)
If dt.Rows.Count > 0 Then
Dim ProgessQty, WIPQty, WOQuantity As String
Dim AgingWC, WOAging As Double
'Dim WCAge, WoAge As TimeSpan
Dim LeadTime As Double
Dim Holiday As Integer
Dim counter As Integer = 1
Dim count As Integer = dt.Rows.Count - 1
For i = 0 To count - 1
ProgessQty = GETProgressWOQuantity(Trim(dt.Rows(i)(0).ToString))
WOQuantity = Trim(dt.Rows(i)(1).ToString)
WIPQty = CInt(ProgessQty)
LeadTime = GetLeadTime(Trim(dt.Rows(i)(2).ToString), lblWC.Text)
Holiday = CheckForHolidays(CDate(dt.Rows(i)(4).ToString), Now())
WOAging = Format((DateDiff(DateInterval.Minute, CDate(dt.Rows(i)(4).ToString), Now())) / 60 / 24, "0.0") - Holiday
AgingWC = WOAging - LeadTime
If AgingWC >= 5 And WIPQty > 0 Then
TempDT.Rows.Add(Trim(dt.Rows(i)(0).ToString), WOQuantity, Trim(dt.Rows(i)(2).ToString), Trim(dt.Rows(i)(3).ToString), WIPQty, Trim(dt.Rows(i)(5).ToString), Math.Round(CDbl(WOAging), 2), Math.Round(CDbl(AgingWC), 2), IIf(Math.Round(CDbl(AgingWC), 2) >= WCLimit, "Red", "Black"))
'
counter += 1
Else
End If
Next
Dim dataView As New DataView(TempDT)
dataView.Sort = " AGINGATWC DESC"
SortDT = dataView.ToTable()
For j = 0 To SortDT.Rows.Count - 1
myArray = myArray & "|" & j + 1
myArray1 = myArray1 & "|" & Trim(SortDT.Rows(j)(0).ToString) 'WO
myArray2 = myArray2 & "|" & Trim(SortDT.Rows(j)(1).ToString) 'WO QTY
myArray3 = myArray3 & "|" & Trim(SortDT.Rows(j)(2).ToString) 'Part Number
myArray4 = myArray4 & "|" & Trim(SortDT.Rows(j)(3).ToString) 'Description
myArray5 = myArray5 & "|" & Trim(SortDT.Rows(j)(4).ToString) 'WIP QTY
myArray6 = myArray6 & "|" & Trim(SortDT.Rows(j)(5).ToString) 'WIP DAYS
myArray7 = myArray7 & "|" & Trim(SortDT.Rows(j)(6).ToString) 'WO Aging
myArray8 = myArray8 & "|" & Trim(SortDT.Rows(j)(7).ToString) 'Aging at WC
myArray9 = myArray9 & "|" & Trim(SortDT.Rows(j)(8).ToString) 'Color
myArray10 = myArray10 & "|" & Trim(SortDT.Rows(j)(5).ToString) 'WONOTE
Next
dt.Clear()
dt.Dispose()
oCmdSql.Dispose()
oConnSql.Close()
ViewState.Clear()
ViewState("JArray") = myArray
ViewState("JArray1") = myArray1
ViewState("JArray2") = myArray2
ViewState("JArray3") = myArray3
ViewState("JArray4") = myArray4
ViewState("JArray5") = myArray5
'ViewState("JArray6") = myArray6
ViewState("JArray7") = myArray7
ViewState("JArray8") = myArray8
ViewState("JArray9") = myArray9
ViewState("JArray10") = myArray10
End If
Catch ex As Exception
lblResult.Text = "Exception Message: " + ex.Message
Finally
End Try
End Sub
Now I realised if I run in Internet Explorer with varchar(max) it says

Guidance, VBA - SELECT CASE clean up

This SELECT CASE scenario is working for me but I think the code can be more friendly ... any advice would be very helpful.
Select Case True 'select case where worker name and action is true then in each case RSworkhours.addnew
Case Me.Worker1.Value <> "" And Me.fw1a1 = 1
With RsWorkHours
.AddNew
!WorkerID = Me.Worker1
!Date = Me.TxtDate
!StandardTime = Me.w1a1s
!Overtime = Me.w1a1o
!Doubletime = Me.w1a1d
!ScaffoldID = Me.cboScaffnum
.Update
End With
Me.fw1a1 = 0
GoTo WorkerHours
Case Me.Worker1.Value <> "" And Me.fw1a2 = 1
With RsWorkHours
.AddNew
!WorkerID = Me.Worker1
!Date = Me.TxtDate
!StandardTime = Me.w1a2s
!Overtime = Me.w1a2o
!Doubletime = Me.w1a2d
!ScaffoldID = Me.cboScaffnum
.Update
End With
Me.fw1a2 = 0
GoTo WorkerHours
The Code iterates through this Select Case 80 times, if there are 16 workers and each have 5 actions.
I was thinking maybe having a loop that modifies the number within the arguments like:
for each x to 16
for each y to 5
If Me.worker & x & .Value <> "" And Me.fw & x & a & y Then
With Recordset
.AddNew
'insert stuff
.Update
End With
End If
Next y
Next x
Does anyone have any insight?
Thank you in advance.
-Matt
You can access all controls by their name from the Controls collection.
Just pass the name of a control and you will get to that control - the name is a string and can of course be dynamic.
Dim x As Long, y As Long
Dim WorkerX As Control, wXaYs As Control, wXaYo As Control, wXaYd As Control
For x = 1 To 16
For y = 1 To 5
Set WorkerX = Me.Controls("Worker" & x)
Set wXaYs = Me.Controls("w" & x & "a" & y & "s")
Set wXaYo = Me.Controls("w" & x & "a" & y & "o")
Set wXaYd = Me.Controls("w" & x & "a" & y & "d")
If WorkerX.Value > "" And wXaYs.Value > "" Then
With Recordset
.AddNew
!WorkerID = WorkerX.Value
!Date = Me.TxtDate
!StandardTime = wXaYs.Value
!Overtime = wXaYo.Value
!Doubletime = wXaYd.Value
!ScaffoldID = Me.cboScaffnum
.Update
End With
End If
Next y
Next x

Set up a filtered query using an array and return a series of calculations in Access VBA

The task: Create a report for Part Numbers that shows several types (On Hand, On Order, etc) in date buckets with each type totaled for the specific range.
For example:
Item 1 => (could be over 2000)
2/5/2017 2/19/2017 2/28/2017 (30 weeks)
On Hand 20 42 33
On Order 0 5 4
Each item is shown on it's own page with related metadata about the item. Each date bucket is based on a user-entered start date with a calculation running against the data set to determine what goes in which bucket and what the totals are.
I have this report fully working for one item. User types one item, selects a date, and the report is created using the following:
Inventory Meta general information and description of the item
Inventory Detail gets all the detailed information
Inventory Totals gets totals for each Types
GetInventory() VBA sets up the buckets and populates the totals
Using a query to get the date buckets would perhaps be easier to get the data into the report. Creating a query with 210 calculated columns (7 types, 30 weeks) wasn't a reasonable approach.
Naturally, selecting one item at a time is not what's wanted.
I have a select box that gets whatever Part Numbers are selected and creates a query on the fly for the Inventory Meta (main report). I have similar code working that runs with the Inventory Totals (sub report) to create a query on the fly for that.
But, as with the Inventory Totals query, each date is a unique value and is it's own row. What I need to be able to do is run the code to build the buckets for each item selected.
I'm stuck.
I have created an array of item numbers (whatever was selected). I can see what's in the array.
What I can't seem to figure out is how to feed each to the code that runs the date comparisons and calculations so that I get a full set of data for each Part Number.
With one number it was easy.... "this one"
vItem = [Forms]![fOptions]![ItemNumber]
Set db = CurrentDb
strSelect = "Select * FROM qInventoryTotals WHERE qInventoryTotals.ItemNumber = [this_one]"
Set qdf = db.CreateQueryDef(vbNullString, strSelect)
qdf.Parameters("this_one").Value = vItem
Set inv = qdf.OpenRecordset
The closest I've come is getting the report to show the same set of data for all part numbers. I suspect there is some small but critical thing, like where a particular loop starts or a variable I've missed or something.
The result of the following is a message box that repeats the same total for each of the part numbers.
Private Sub CreateOne_Click()
On Error GoTo Err_cmdOpenQuery_Click
'----------- Selection box check for dates -------------
If IsNull(Forms!fFish1!Week1) Then
MsgBox "A Sunday date must be selected", , "Please select a date"
ElseIf Weekday(Forms!fFish1!Week1) = 1 Then
'MsgBox "That is Sunday"
Forms!fFish1!Week1 = Forms!fFish1!Week1
Else
MsgBox "Starting Week needs to be a Sunday date" _
, , "Sorry, that's not Sunday"
' clears the 'not Sunday' selection
Forms!fFish1!Week1 = ""
Exit Sub
End If
'-------------------------------------------------
' Declarations =====================================
Dim db As DAO.Database
Dim iMeta As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant
Dim strSlect As String
Dim vItem As Variant
' Setup -------------------------------------
Set db = CurrentDb()
strSQL = "SELECT * FROM qInventoryTotals2"
'----------------------------------------------------------------------
' Get whatever is selected and loop through the selections
' This defines which numbers are in the list
'----------------------------------------------------------------------
For i = 0 To Forms!fFish1.box4.ListCount - 1
If Forms!fFish1.box4.Selected(i) Then
If Forms!fFish1.box4.Column(0, i) = "All" Then
flgSelectAll = True
End If
strIN = strIN & "'" & Forms!fFish1.box4.Column(0, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE [ItemNumber] in " & _
"(" & Left(strIN, Len(strIN) - 1) & ")"
'If "All" was selected in the listbox, don't add the WHERE condition
If Not flgSelectAll Then
strSQL = strSQL & strWhere
End If
'-------------------------------------------------------
' Create a query that has all the selected item numbers
db.QueryDefs.Delete "qInventoryTotals3"
Set iMeta = db.CreateQueryDef("qInventoryTotals3", strSQL)
Set inv = iMeta.OpenRecordset
'==========================================================================
' Create an array to pull out each of the Item numbers one at a time
Dim Count As Integer, r As Integer
Count = 0
For i = 0 To Forms!fFish1.box4.ListCount - 1
If Forms!fFish1.box4.Selected(i) Then
vItem = Forms!fFish1.box4.Column(0, i)
'vItemFilter = Forms!fFish1.box4.Column(0, i)
'MsgBox (vItem), , "one by one"
Count = Count + 1
End If
Next i
''MsgBox (Count), , "count how many items are in the set"
' Get the count for how many items are in the currently selected list
' Displays one item at a time -
' Set up the array ------------------------------
'------------------------------------------------
ReDim vItem(Count)
r = 0
For i = 0 To Forms!fFish1.box4.ListCount - 1
If Forms!fFish1.box4.Selected(i) Then
vItem(r) = Forms!fFish1.box4.Column(0, i)
r = r + 1
End If
Next i
'Check the values stored in array
''For i = 0 To Count - 1
''MsgBox vItem(i), , "show all values from the array"
''Next
' have all values from the array. Each in it's own message box
'===============================================================================
' Set up the item numbers ---------------------------
Dim part As Variant
part = vItem
With vItem
For i = LBound(vItem) To UBound(vItem) - 1
MsgBox ("There are" & " " & (vItem(i)) & " " & "fishies"), , "Whatcha' got now?"
' cycles through each number
' Past Due ============================================
Dim tPOPast As Double
Dim tBCPast As Double
Dim tBPast As Double
Dim tEPast As Double
If inv!ItemNumber = part(i) And inv.Fields("RequiredDate") < Forms!fFish1!Week1 Then
'displays the first part number with it's value, then the remaining numbers with no value
' If inv.Fields("RequiredDate") < Forms!fFish1!Week1 Then
'displays each of the part numbers with the same value
tBPast = inv.Fields("TotalOnHand")
tPOPast = tPOPast + inv.Fields("SumOfSupply")
tBCPast = tBCPast + inv.Fields("SumOfDemand")
' Calculate ending inventory for the week ===================
tEPast = tBPast + tPOPast + tBCPast
' Show something for testing ==============================
MsgBox (tBPast & " " & part(i)), , "show Me the money" ' displays same total for each part number
End If
'end this condition, next condition follows
'----------------- do it again -------------------------------
Next
' Finished with the weekly buckets =====================================
End With
'=========================================================================
'-------------------- error management for the selection box ------------------
Exit_cmdOpenQuery_Click:
Exit Sub
Err_cmdOpenQuery_Click:
If Err.Number = 5 Then
MsgBox "Pick one, or more, item numbers from the list" _
, , "Gotta pick something!"
Resume Exit_cmdOpenQuery_Click
Else
'Write out the error and exit the sub
MsgBox Err.Description
Resume Exit_cmdOpenQuery_Click
End If
'---------------------------------------------------------------------------
End Sub
The solution I found was to set variables for the values from the array and use them to dynamically update a table. From that, I created a query to sum the values and used that as the basis for the report. The key was GetRows()
Get the unique items and read the the rows of data into the first array
Dim rNum As Integer
rNum = myItems.RecordCount
Dim varItem As Variant
Dim intRi As Integer 'rows of unique items
Dim intCi As Integer 'columns of unique items
Dim intNCi As Integer
Dim intRCi As Integer
varItem = myItems.GetRows(rNum)
intNRi = UBound(varItem, 2) + 1
intNCi = UBound(varItem, 1) + 1
For intRi = 0 To intNRi - 1
For intCi = 0 To intNCi - 1
vItem = varItem(intCi, intRi)
Use vItem to dynamically create a new recordset to set up the weekly buckets
strSelect = "Select * FROM qInventoryTotals2 WHERE qInventoryTotals2.ItemNumber = [this_one]"
Set qdf = db.CreateQueryDef(vbNullString, strSelect)
qdf.Parameters("this_one").Value = vItem
Set inv = qdf.OpenRecordset
Count the records, create a second array
Dim invNum As Integer
invNum = inv.RecordCount
Dim varRec As Variant
Dim intR As Integer
Dim intC As Integer
Dim intNC As Integer
Dim intRC As Integer
Dim cItem As String
Dim cRequired As Date
Dim cPO As Double
Dim cBC As Double
Dim cOnHand As Double
varRec = inv.GetRows(invNum)
intNR = UBound(varRec, 2) + 1
intNC = UBound(varRec, 1) + 1
For intR = 0 To intNR - 1
For intC = 0 To intNC - 1
cItem = varRec(0, intR)
cRequired = varRec(1, intR)
cOnHand = varRec(2, intR)
cPO = varRec(3, intR)
cBC = varRec(4, intR)
cSO = varRec(5, intR)
cPD = varRec(6, intR)
cIN = varRec(7, intR)
cJT = varRec(8, intR)
cWO = varRec(9, intR)
'------------- finish getting inventory columns --------------------
Next intC
And then set up the buckets for each week
If cRequired < Week1 Then
recOut.AddNew
recOut.Fields("ItemNumber") = cItem
recOut.Fields("tB") = cOnHand
recOut.Fields("tPO") = cPO
recOut.Fields("tBC") = cBC
recOut.Fields("tSO") = cSO
recOut.Fields("tPD") = cPD
recOut.Fields("tIN") = cIN
recOut.Fields("tJT") = cJT
recOut.Fields("tWO") = cWO
recOut.Fields("tE") = cOnHand + cPO + cBC + cSO + cPD + cIN + cJT + cWO
recOut.Fields("RequiredDate") = cRequired
recOut.Fields("GroupDate") = Week1
recOut.Update
' tE0 = cOnHand + cPO + cBC + cSO + cPD + cIN + cJT + cWO
Dim tryme As Double
tryme = DLookup("teMe", "qBuckets", "GroupDate = Week1")
tE0 = tryme
End If

Finding unique partitions for a number

I am using below code for finding partitions for a given number (N). How can I ensure only unique partitions? For instance partitions (1, 1, 1, 7), (1, 1, 7, 1), (1, 7, 1, 1) and (7, 1, 1, 1) would be considered the same and only one of these should be output.
Thanks
Regards
Dim N = 10
For i As Integer = 0 To N
For j As Integer = 0 To N
For k As Integer = 0 To N
For l As Integer = 0 To N
If i + j + k + l = N Then
Dim St As String = String.Format("({0:d}, {1:d}, {2:d}, {3:d})", i, j, k, l)
Console.WriteLine(St)
End If
Next
Next
Next
Next
Console.Read()
EDIT: Below seems to be working from someone's suggestion;
Module Module1
Sub Main()
Console.WriteLine("Please enter an integer.")
Dim sReadLine As String = Console.ReadLine()
Dim iValue As Integer
If IsNumeric(sReadLine) Then
iValue = CInt(sReadLine)
Else
Console.WriteLine("'" & sReadLine & "' is not a numeric value. Press any key to exit.")
'Application.Exit()
Console.Read()
Exit Sub
End
End If
Console.Clear()
Console.WriteLine("Number is {0}", iValue)
Console.WriteLine("")
Partitions1(iValue)
Exit Sub
End Sub
Dim partitions As New List(Of Part)
Private Sub Partitions1(N As Integer)
For i As Integer = 0 To N
For j As Integer = 0 To N
For k As Integer = 0 To N
For l As Integer = 0 To N
If i + j + k + l = N Then
Dim thisPartition As New Part()
thisPartition.Parts = New Integer() {i, j, k, l}
If Not partitions.Contains(thisPartition) Then
partitions.Add(thisPartition)
End If
End If
Next
Next
Next
Next
For Each x In partitions
Dim St = "("
For Each y In x.Parts
St = St & y & ", "
Next
St = Left(St, Len(St) - 2)
St = St & ")"
Console.WriteLine(St)
Next
Console.WriteLine("")
Console.WriteLine("{0} unique partititons found.", partitions.Count)
Console.Read()
End Sub
Public Class Part 'Sorted array of integer with comparer
Implements IEquatable(Of Part)
Public Property Parts As Integer()
Get
Return m_Parts
End Get
Set(value As Integer())
m_Parts = value
Array.Sort(m_Parts)
End Set
End Property
Private m_Parts As Integer()
Public Overloads Function Equals(other As Part) As Boolean _
Implements IEquatable(Of Part).Equals
If other Is Nothing Then
Return False
End If
If other.Parts.GetLength(0) <> m_Parts.GetLength(0) Then Return False
Dim result As Boolean = True
Array.Sort(other.Parts)
For I As Integer = 0 To other.Parts.GetLength(0) - 1
If other.Parts(I) <> m_Parts(I) Then
result = False
Exit For
End If
Next
Return result
End Function
' Should also override == and != operators.
End Class
End Module
Collect the found solutions in a list, then writen an algo which eliminates the duplicates from the list and then print the list.

VBscript - Transpose CSV File

Does anyone have a short script in VBscript for transposing a Matrix (given as CSV (comma separated values) file)?
A, 1, 2, 3
B, 7, 5, 6
->
A, B
1, 7
2, 5
3, 6
Many Thanks in advance
Tom
So by creating dynamic arrays and auto-increment their growth in parallel with discovering new columns of the original matrix, you can auto build the new data structure quite quickly.
Const OutputCSV = "C:\op.csv"
Dim dt_start, WriteOutput : dt_start = Now
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim file : Set file = fso.OpenTextFile("C:\test.csv", 1, True)
Set WriteOutput = fso.OpenTextFile(OutputCSV, 8, True)
Dim fc : fc = file.ReadAll : file.close : Dim fcArray : fcArray = Split(fc, vbCrLf)
WScript.echo "Before Transpose"
WScript.echo "----------------"
WScript.echo fc
WScript.echo "----------------"
Dim opArray() : ReDim opArray(0)
For Each row In fcArray
Dim tmp: tmp = Split(row, ",")
For ent=0 To UBound(tmp)
If ent > UBound(opArray) Then
ReDim Preserve opArray(UBound(opArray)+1)
opArray(ent) = Trim(tmp(ent))
Else
If Len(opArray(ent)) > 0 Then
opArray(ent) = opArray(ent) & "," & Trim(tmp(ent))
Else
opArray(ent) = Trim(tmp(ent))
End If
End If
Next
Next
Dim dt_end : dt_end = Now
WScript.echo "After Transpose"
WScript.echo "----------------"
WScript.echo Join(opArray, vbCrLf)
WScript.echo "----------------"
WScript.echo "Script Execution Time (sec): " & DateDiff("s", dt_start, dt_end)
WriteOutput.Write Join(opArray, vbCrLf) : WriteOutput.Close
If it's just two lines with an equal number of values, you can read both into arrays using the Split function:
a1 = Split(FileIn.ReadLine, ",")
a2 = Split(FileIn.ReadLine, ",")
Then, iterate the arrays and write each element:
For i = 0 To UBound(a1)
FileOut.WriteLine a1(i) & ", " & a2(i)
Next
I'm assuming you know how to open files for reading and writing?
Edit: It sounds like you may have an unknown number of rows to read. In that case, you can use an array of arrays:
Dim a(255) ' Hold up to 255 rows. Adjust as needed. Or use ReDim Preserve to grow dynamically.
Do Until FileIn.AtEndOfStream
a(i) = Split(FileIn.ReadLine, ",")
i = i + 1
Loop
Then, to write:
For j = 0 To UBound(a(0))
' Concatenate the elements into a single string...
s = ""
For k = 0 To i - 1
s = s & a(k)(j) & ","
Next
' Write the string without the final comma...
FileOut.WriteLine Left(s, Len(s) - 1)
Next