Ændring af en celles værdi i excel vha. vba

Private Sub btnGo_Click()
    Dim oHyp As Hyperlink
    Dim Resultat As String
    Dim strFind As String
    Dim strReplace As String
   
    strFind = txtFind.Value
    strReplace = txtReplace.Value
   
    lbxResultat.Clear
    lbxResultat2.Clear
   
    For Each oHyp In ActiveWorkbook.ActiveSheet.Hyperlinks
        Resultat = oHyp.Address
        lbxResultat.AddItem (oHyp.Address)
        Resultat = Replace(Resultat, strFind, strReplace)
        oHyp.Address = Resultat
        lbxResultat2.AddItem (oHyp.Address)
    Next oHyp
End Sub

Hvis du skal have hjælp til at rette det til, så siger du bare til.

Øhmm... det fatter jeg nada af.

kan man ikke bruge noget med .offset og nogle if-sætninger? Det du skriven ovenfor er lige hardcore nok :-)

Sidder og er ved at lave en obligatorisk edb-opgave -læser HA, er derfor ikke den vilde koder... Så hvis du kunne gøre koden lidt mere simpel ville det være super!

Her er to eksempler på måder at angribe det på.


Eksempel 1

Public Sub RenameRegistrationNumber()
    Dim rCell As Range
   
    For Each rCell In Worksheets("old_database").UsedRange.Columns(2).Cells
   
        rCell.Value = GetNewValue(rCell.Value)
   
    Next rCell
   
    Set rCell = Nothing
End Sub

Public Function GetNewValue(ByVal sValue As String) As Long
    Dim lRetVal As Long
    Dim iTemp As Integer
    Dim vntCode(1 To 1, 1 To 6) As Variant
   
    vntCode(0, 1) = 8011
    vntCode(1, 1) = 8001
    vntCode(0, 2) = 8012
    vntCode(1, 2) = 8002
    vntCode(0, 3) = 8013
    vntCode(1, 3) = 8003
    vntCode(0, 4) = 8014
    vntCode(1, 4) = 8004
    vntCode(0, 5) = 8015
    vntCode(1, 5) = 8005
    vntCode(0, 6) = 8016
    vntCode(1, 6) = 8006
   
    For iTemp = LBound(vntCode, 2) To UBound(vntCode, 2)
        If vntCode(0, iTemp) = sValue Then
            lRetVal = vntCode(1, iTemp)
            Exit For
        End If
    Next iTemp
   
    GetNewValue = lRetVal
End Function


Eksempel 2

Public Sub ReplaceNumbers()
    PleaseReplace 8011, 8001
    PleaseReplace 8012, 8002
    PleaseReplace 8013, 8003
    PleaseReplace 8014, 8004
    PleaseReplace 8015, 8005
    PleaseReplace 8016, 8006
End Sub

Public Sub PleaseReplace(ByVal vValueOld As Variant, ByVal vValueNew As Variant)
    Worksheets("old_database").UsedRange.Cells.Replace What:=vValueOld, _
        Replacement:=vValueNew, LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

OK..

Her er en simpel en:
Bare glem den første :-)

Sub expTest()
For Each c In Worksheets("old_database").Range("B1015:B1052")
If c.Value = "8011" Then
c.Value = "8016"
End If
Next

End Sub

For Each c In Worksheets("old_database").Range("B1015:B1052")
c.Value = c.Value -10
next

Husk kør den kun 1 gang, den trækker 10 fra celleværdien

DOH...kabbak
Det var da meget næmmere :-)

Det er jo klart den nemmeste måde at gøre det på! Her "vinder" Kabbak helt klart, kan jeg evt. stoppe "for each", sådan at den kun trækker 10 fra én gang?

(hvordan tildeler jeg pointene til kabbak?)

Ved at jeg giver et svar. ;-))

sub ret()
For Each c In Worksheets("old_database").Range("B1015:B1052")
c.Value = c.Value -10
next
end sub

du skal bare køre subben en gang, så kan du slette den

jeg takker mange gange for jeres hjælp! jeg opretter nok lige en ny tråd inden så længe med endnu et spørgsmål :-)

take care...

Tak for point. ;o))