0

Excel でのデータの例:
COL A B C D F..... 1 SL..... 2 SL8 AL4 CD3 CN5 CD4 AL8

セル内の文字識別子に基づいて、条件付きで合計しています。UDF はセル (F2) に入力されます=SumDigByLTR2(A2:C2,F1)。ここで、F1 - I1 は合計する条件です (文字、SL、AL など)。結果は次のようになります。
SL=8 AL=12 CD=7 CN=5

このユーザー定義関数を VBA で作成しました (以下)。オンラインで見つけたいくつかのコードを変更しました。最初は機能していましたが、不思議なことに機能しなくなりました。XLS や VBA を変更した覚えはありません。考え？
コメントアウトされた「delim」行は無視できます。文字間に区切り文字を設定するオプションを用意しようとしていました。うまくいかなかったので、スペースを使用しました。 

Option Explicit
Function SumDigByLTR2(rg As Range, ltr As String) As Double
Dim c As Range   'c = a cell
Dim delimiter As String
Dim InStrResult As Long  'returns the position of "ltr" in the cell e.g. abc34, if ltr="c", then Instr() = 3
Dim MidResult As Long
Dim numltr As Integer 'number of characters in the critera, i.e. AL or A
'Dim delim_text As String 'this will identify the user preferred demlimiter text.
Dim StartPos As Integer  'position of ltr + number of characters in the critera, i.e. AL or A
Dim DelimPos As Integer  'position of delimiter after "ltr"
Dim numlen As Integer  'returns length of the desired numbers i.e. "3" =1 or "10" =2

For Each c In rg
'delimiter = Sheet7.Range("O8").Value
    InStrResult = InStr(1, c.Text, ltr, vbTextCompare)
    If InStr(1, c.Text, ltr, vbTextCompare) > 0 Then

        StartPos = InStrResult + Len(ltr)
        DelimPos = InStr(InStrResult, c.Text, " ") 'Sheet7.Cells(8, 15).Value)  '"O"=15

            If DelimPos = 0 Then
               MidResult = Right(c.Text, Len(c.Text) - StartPos + 1)  '"+1" because if cell=al3; starpos will = 3 & len(cell)=3; therefore   Len-startpos=0
            Else
               numlen = DelimPos - StartPos + 1
               MidResult = Mid(c.Text, StartPos, numlen)
            End If

        SumDigByLTR2 = SumDigByLTR2 + MidResult

    End If
Next c
End Function


'Original
'http://www.pcreview.co.uk/forums/excel-extract-and-sum-numerals-mixed-text-numeral-cell-range-t937450.html

'Option Explicit
'Function SumDigByLtr(rg As Range, ltr As String) As Double

'Dim c As Range

'For Each c In rg
'If InStr(1, c.Text, ltr) > 0 Then
'SumDigByLtr = SumDigByLtr + Replace(c.Text, ltr, "")

'End If
'Next c
'End Function

更新 #1、2015 年 11 月 25 日、何が UDF を壊しているのかを発見しました。

Excel 2010 は新しいワークシート セットを作成し、すべての元の名前を変更したようです。たとえば、Sheet10 は Sheet101 になり、Sheet13 は Sheet131 になります。これにより、UDF が機能しなくなります。「新しい」「sheet10」と「sheet13」は、VBA プロジェクト ウィンドウ以外には存在しないようです。「新しい」シートには、横に青いアイコンがあります。

Excelが「新しい」シートを作成し、「古い」シートの名前を独自に変更したため、UDFの参照を新しいシート名に変更する必要がありました。#VALUE エラーはもうありません。

ここに画像の説明を入力 ここに画像の説明を入力

ここに画像の説明を入力

Excel/VBA がこれらの存在しないシートを作成し、元のシートの名前を変更した原因を知っている人はいますか?

更新 #2、2016 年 1 月 6 日、12 月上旬にすべての実際の既存のシートを新しいワークブックにコピーしました
。今日の時点で、この新しいワークブックの数式は、開いたときに再びすべてエラー (#VALUE) です。前回の更新で見たように、Excel は存在しないシートを作成していません。先週、XLS と数式は機能していましたが、変更はありませんでした。元のワークブック (存在しないワークシートを含む pix に表示されているもの) には、#VALUE エラーはありません。両方のワークブックは同じコンピューター上にあり、比較のために先月以上にまとめて更新されています。

UPDATE3、2016 年 1 月 6 日誤ってテキスト セルを移動してから [元に戻す] をクリックしたところ、すべての #VALUE エラーがなくなり、正しい計算ができるようになりました。なんてこった。

4

1 に答える 1

0

これが私の最終的な UDF でした。

Option Explicit
Function Sumbytext(rg As Range, ltr As String) As Double
'Similar to Excel SumIf, except that text can be in the cell with the number.
'That text ("ltr") can identify the number, as a condition to sum.
'e.g. Cell1 (D5 T8 Y3), Cell2(D3 A2), Cell3 (T8) >>> Sums: D=8 T=16 Y=3 A=2

Dim c As Range   'c = a cell
Dim InStrResult As Integer  'returns the position of "ltr" in the cell 
e.g. abc34, if ltr="c", then Instr() = 3
Dim MidResult As Double
Dim numltr As Integer 'number of characters in the critera, i.e. AL or A
Dim StartPos As Integer  'position of ltr + number of characters in the critera, i.e. AL or A
Dim DelimPos As Integer  'position of delimiter after "ltr"
Dim numlen As Integer  'returns length of the desired numbers i.e. "3" =1 or "10" =2
Dim Abbr As Range  'abbreviation of holiday - this is displayed on the calendar
Dim rgAbbr As Range  'the list of abbreviations corresponding to the list of holidays

Set rgAbbr = Worksheets("Holidays").Range("List_HolAbbr")

For Each c In rg
  For Each Abbr In rgAbbr
    If UCase(c) = UCase(Abbr) Then GoTo skipcell   'skip cell if the holiday names are in the cell >> 'Labor day' gives an error because the function looking for a cell containing "LA".  Therefore exclude "Labor".
    Next Abbr
     If InStr(1, c.Text, UCase("OCT"), vbTextCompare) > 0 Then GoTo skipcell 'skip cell if it inscludes "Oct".  >> results in error due to the "CT" being used as "ltr".
     InStrResult = InStr(1, c.Text, ltr, vbTextCompare)
     If InStrResult > 0 Then
        StartPos = InStrResult + Len(ltr)
        DelimPos = InStr(InStrResult, c.Text, " ")

        If DelimPos = 0 Then
          MidResult = Right(c.Text, Len(c.Text) - StartPos + 1) '"+1" because if cell=al3; starpos will = 3 & len(cell)=3; therefore Len-startpos=0
        Else
      numlen = DelimPos - StartPos + 1
      MidResult = Mid(c.Text, StartPos, numlen)
        End If

        Sumbytext = Sumbytext + MidResult

    End If
skipcell:
Next c
End Function

更新 #1 上記の更新 #1 に示されているワークブックの問題は、Excel によってシート名が自動的に変更されるため、UDF を壊しているように見えました。Excelが「新しい」シートを作成し、「古い」シートの名前を独自に変更したため、UDFの参照を新しいシート名に変更する必要がありました。#VALUE エラーはもうありません。

更新 #2:
上記の更新 #2 で #VALUE エラーがどのように、またはなぜ修正されたのかわかりません。提案？

于 2015-07-09T15:13:56.727 に答える