VBA Variable in variable

woensdag 24 augustus 2011 17:50

Acties:

0 Henk 'm!

Topicstarter

Hallo iedereen,

Wie o wie kan mij helpen? Ik schrijf nu al een tijdje VBA, maar hier kom ik niet uit (zie dikgedrukt). Ik wil via excel waardes toekennen aan variabelen die voldoen aan de eisen van het IF statement. Dit wil ik doen door gebruik te maken van de For Each - Next functie.

Zodra de cel voldoet aan de eisen wil ik dat "i" telkens opgeteld wordt met 1 en het variabel gekoppelt wordt.

dn(i)

Bij gebruik van een userform weet ik dat het werkt via controls("dn" & i), maar hier kom ik echt niet uit.

Zie onderstaand mijn VBA code.

Bedankt alvast!

Mvg Koen

Sub tester1()

Dim dn() As Variant

ThisWorkbook.Sheets("shipdata").Select
Range("B1:B3").Select

i = 0

For Each cell In Selection

If cell.Value = "" Then
MsgBox ("leeg")
Exit For
End If

If cell.Offset(0, 11).Value > 0 And cell.Offset(0, 12).Value = "0" Then
MsgBox ("true")
i = i + 1
dn(i) = cell.Offset(0, 11).Value
'("inp_art" & I)
'ActiveCell.Offset(0, x).Value = Controls("inp_art" & I).Value
End If

Next

MsgBox (dn1)
MsgBox (dn2)

End Sub

woensdag 24 augustus 2011 17:53

Acties:

0 Henk 'm!

CodeCaster

Can I get uhm...

Wat werkt er niet dan? Krijg je een foutmelding?

Je kunt in VB(A) voor zover ik weet geen 'variabele variabelen' gebruiken, maar wel arrays. Waar je al aardig mee op weg was, maar het uitlezen doe je dan met dn(1) en niet dn1. En iets in een array stoppen of eruit halen gaat niet voordat je hem hebt geïnitialiseerd.

[ Voor 27% gewijzigd door CodeCaster op 24-08-2011 17:55 ]

https://oneerlijkewoz.nl
Op papier is hij aan het tekenen, maar in de praktijk...

woensdag 24 augustus 2011 19:52

Acties:

0 Henk 'm!

KoenAlberts

Topicstarter

CodeCaster schreef op woensdag 24 augustus 2011 @ 17:53:
Wat werkt er niet dan? Krijg je een foutmelding?

Je kunt in VB(A) voor zover ik weet geen 'variabele variabelen' gebruiken, maar wel arrays. Waar je al aardig mee op weg was, maar het uitlezen doe je dan met dn(1) en niet dn1. En iets in een array stoppen of eruit halen gaat niet voordat je hem hebt geïnitialiseerd.

Hieronder een deel van mijn code. Alles gaat in principe prima, maar het maken een increment variable lukt me niet.

dus voor elke "next" een omhoog. BV: dn1 = dn1234 --> next dn2 = dn4321 etc.

Visual Basic:

Sub tester1()


Dim dn() As Variant


ThisWorkbook.Sheets("shipdata").Select
Range("B1:B3").Select

i = 0

For Each cell In Selection

If cell.Value = "" Then
MsgBox ("leeg")
Exit For
End If

If cell.Offset(0, 11).Value > 0 And cell.Offset(0, 12).Value = "0" Then
MsgBox ("true")
i = i + 1
dn(i) = cell.Offset(0, 11).Value
End If

Next

MsgBox (dn1)
MsgBox (dn2)


End Sub


Sub EmailOSO()

'Error 429 occurs with GetObject if Outlook is not running.
   On Error Resume Next
   Set objOutlook = GetObject(, "Outlook.Application")
   
   If Err.Number = 429 Then 'Outlook is NOT running.
      MsgBox "Outlook moet aan staan bij het gebruik van deze subroutine!!!"
    Exit Sub
   End If


If MsgBox("Weet je zeker dat je de OSO-File wilt verzenden?", vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If

If MsgBox("Wil je de stock query refreshen?", vbQuestion + vbYesNo) = vbYes Then
    Sheets("Stock").Select
    Range("A1").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
End If

    Sheets("SO").Select
    Range("A1").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Dim filepath As String
Dim CurrentDate As String
Dim CurrentTime As String
Dim Filename As String

CurrentTime = Time 'This variable contains the current time.
CurrentDate = Format(Date, "DD-MM-YYYY") 'This variable contains the current date.

If Left(CurrentDate, 1) = "0" Then
    CurrentDate = Right$(CurrentDate, Len(CurrentDate) - 1)
End If

If Len(CurrentDate) = 9 Then

    If Mid(CurrentDate, 3, 1) = "0" Then
        CurrentDate = Left$(CurrentDate, 2) & Right$(CurrentDate, 6)
    End If
    
End If

If Len(CurrentDate) = 10 Then
    
    If Mid(CurrentDate, 4, 1) = "0" Then
        CurrentDate = Left$(CurrentDate, 3) & Right$(CurrentDate, 6)
    End If
    
End If

SaveDate = CurrentDate


Dim SaveBackupString As String 'This is the string which contains the variables for saving a copy of this workbook as backup.
SaveBackupString = WorkbookPath & "\backup\" & Format(CurrentDate, "DD-MM-YY") & " " & Format(CurrentTime, "hh.mm.ss") & " " & ActiveWorkbook.Name

'ActiveWorkbook.SaveCopyAs Filename:=SaveBackupString 'This string saves the copy of this workbook in the backup folder (which is in the root of the source file).

'ActiveWorkbook.Save

For Each cell In ActiveWorkbook.Sheets("COUNTER").Range("A:A")

    If cell.Value = CurrentDate Then
        ActiveWorkbook.Sheets("COUNTER").Unprotect
        cell.Offset(0, 1).Value = cell.Offset(0, 1).Value + 1
        IDNumber = cell.Offset(0, 1).Value
        ActiveWorkbook.Sheets("COUNTER").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End If

Next


CurrentDate = Format(Date, "DD-MM-YYYY")
Filename = "OSO" & "_" & CurrentDate & "_" & IDNumber & ".txt"
Destfolder = ActiveWorkbook.Path & "\" & "Backup OSO-files" & "\" & CurrentDate & "\"


Set wsh = CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
     
                        If Not fs.FolderExists(Destfolder) Then
                        fs.CreateFolder Destfolder
                        End If


'##################################################################################

ActiveWorkbook.Sheets("OSO").Range("A1").Select
y1 = ActiveCell.Row


For Each cell In ActiveWorkbook.Sheets("OSO").Range("A:A")

If cell.Value = "" And cell.Offset(1, 0).Value = "" Then
y2 = cell.Offset(-1, 0).Row
Exit For
End If

Next


OSORANGE = "A" & y1 & ":" & "A" & y2
   
MyFileName = Destfolder & Filename

For Each cell In ActiveWorkbook.Sheets("OSO").Range(OSORANGE)

Open MyFileName For Append As #1
Print #1, cell.Value
Close #1

Next


'########################################################################################

'Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "OSO" & vbNewLine & vbNewLine & _
              "OSO "
    On Error Resume Next
    With OutMail
        .to = "MYEMAIL@BLABLA.com"
        .CC = ""
        .BCC = ""
        .Subject = Filename
        .Body = strbody
        .Attachments.Add (Destfolder & Filename)
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

ActiveWorkbook.Worksheets("OSO_DB").Select
ActiveSheet.Unprotect

If Range("A2") = "" Then
Range("A2").Select
Else

    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select

End If

MyPath = Destfolder & Filename
ActiveCell.Formula = "=HYPERLINK(""" & MyPath & """,""" & Filename & """)"
ActiveCell.Offset(0, 1).Value = CurrentTime
ActiveCell.Offset(0, 2).Value = ActiveWorkbook.Sheets("Shiplist").Range("DNFROM").Value
ActiveCell.Offset(0, 3).Value = ActiveWorkbook.Sheets("Shiplist").Range("DNTO").Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

ActiveWorkbook.Save


End Sub

[ Voor 0% gewijzigd door F_J_K op 25-08-2011 17:39 . Reden: code tags ]

donderdag 25 augustus 2011 15:38

Acties:

0 Henk 'm!

Reptile209

- gers -

Kijk eens naar dit voorbeeldje:

Visual Basic:

Sub Test()
    Dim Variabele(10) As String

    For n = 1 To 10
        Variabele(n) = "Dit is variabele nummer " & n
    Next n
    
    Debug.Print "Je rijtje:"
    For n = 1 To 10
        Debug.Print Variabele(n)
    Next
End Sub

Zorg dat je het Direct / Immediate venster open hebt staan, dan zie je daar de output van Debug.Print.

Zo scherp als een voetbal!

donderdag 25 augustus 2011 17:43

Acties:

0 Henk 'm!

F_J_K

Moderator CSA/PB

Front verplichte underscores

Excel

offtopic:
KoenAlbers. Je gaf een hele lap code die zegmaar niet echt goed leesbaar was. Te veel code die ook nog eens niet is indented, etc. leest niet lekker en maakt het dus lastiger om mee te denken.

Inkorten zal ik niet voor je doen maar ik ben zo vrij geweest om er code tags omheen te zetten. Zie ook http://gathering.tweakers.net/forum/view_message/36642423 voor hoe en wat. Doe dat ajb zelf de volgende keer ook als je (de relevante delen van) code post

Daarnaast: het is me nog steeds niet duidelijk wat / waarom er nu precies niet lukt en wat het uiteindelijke doel is.

dus voor elke "next" een omhoog. BV: dn1 = dn1234 --> next dn2 = dn4321 etc.

Ik (maar misschien ben ik dom) snap bijvoorbeeld je voorbeeld niet

Misschien kan je het even met korte pseudocode en tekst herhalen.

[ Voor 27% gewijzigd door F_J_K op 25-08-2011 18:00 ]

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)

Onderwerpen