位置細胞並提取數值

Question

我目前「試圖」設置在Excel中網格，其中

• 用戶輸入的引用（例如HP1或HP234）和，
• 我可以自動檢測它輸入的單元格和單元格中的數值（例如，HP1 = 1,HP234 = 234）。

我已經開始玩下面的代碼。在msgbox("work")部分 - 我只是用它來測試代碼。在這裏，我想返回單元格中的數值和單元格位置，以便將它們放到報表中。

任何幫助將不勝感激。

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim rng As Range 
Dim rngTarget As Range 

Set rngTarget = Range("a1:a100")  
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then   
    For Each rng In rngTarget 
     If InStr(1, prNg, "H") > 0 And InStr(1, rngEachValue, "P") = 0 Then 
       MsgBox ("works")    
     End If  
    Next  
End If  

End Sub 

Answer 1

我發現這是一個很好的問題，所以把一些工作放到答案中。我認爲這將做你想要的！它甚至可以使用小數點和千位分隔符。

我承認NumericalValue功能可以以不同的方式來創建，以及（找到的第一個和最後一個數字和繩子的那mid一部分。

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim rng As Range 
    Dim rngTarget As Range 
    Dim varValue As Variant 

    Set rngTarget = Range("a1:a100") 

    If Not Intersect(Target, rngTarget) Is Nothing Then 
     For Each rng In rngTarget 
      'only check cells that contain an H and a P 
      If InStr(1, rng, "H") > 0 And InStr(1, rng, "P") > 0 Then 
       'find the numerical value if any (Empty if not found) 
       varValue = NumericalValue(rng.Value2) 
       If Not IsEmpty(varValue) Then 
        MsgBox "hurray the value of cell " & rng.AddressLocal & " is " & varValue 
       End If 
      End If 
     Next 
    End If 

End Sub 

'return the first numerical value found in the cell 
Private Function NumericalValue(ByVal strValue As String) As Variant 
    Dim intChar As Integer 
    Dim booNumberFound As Boolean 
    Dim intDecimal As Integer 

    booNumberFound = False 

    NumericalValue = Val(strValue) 

    For intChar = 1 To Len(strValue) Step 1 
     'if a number found then grow the total numerical value with it 
     If IsNumeric(Mid(strValue, intChar, 1)) Then 
      NumericalValue = NumericalValue * IIf(intDecimal = 0, 10, 1) + _ 
        Val(Mid(strValue, intChar, 1)) * 10^-intDecimal 
      If intDecimal > 0 Then 
       intDecimal = intDecimal + 1 
      End If 
      booNumberFound = True 
     'if the decimal separator is found then set the decimal switch 
     ElseIf intDecimal = 0 And booNumberFound = True And Mid(strValue, intChar, 1) = Application.DecimalSeparator Then 
      intDecimal = 1 
     'skip the thousand separator to find more numbers 
     ElseIf booNumberFound = True And Mid(strValue, intChar, 1) = Application.ThousandsSeparator Then 
     ElseIf booNumberFound = True Then 
      Exit For 
     End If 
    Next intChar 

End Function 

Answer 2

你最方式在那裏，請嘗試以下：

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim rng As Range 
Dim rngTarget As Range 
Dim sText As String 

Set rngTarget = Range("a1:a100") 

If Not Intersect(Target, Range("A1:A100")) Is Nothing Then  
    For Each rng In rngTarget   
     If InStr(1, rng.Text, "H") > 0 And InStr(1, rng.Text, "P") > 0 Then  
      sText = rng.Text 
      sText = Replace(sText, "H", "") 
      sText = Replace(sText, "P", "") 
      Debug.Print rng.Address & " = " & Val(sText) 
     End If  
    Next  
End If 

End Sub