我的代码出现错误,我不知道为什么。

huangapple go评论56阅读模式
英文:

My code have an error and I don't know why

问题

在代码的这一部分:Set celdaB = ws.Cells(preguntaRow, "B") 有时会出现错误 1004。为什么会这样?

我尝试了我所知道的一切,但我希望知道它为什么有时能工作,有时不能工作。

注意:在代码中,"用于表示双引号,实际使用时应该使用正常的双引号 "

错误 1004 通常是由于工作表或单元格引用问题引起的。这种情况可能是因为 preguntaRow 的值在某些情况下没有被正确设置为有效的行号,导致尝试引用一个不存在的单元格。

要排除这个问题,你可以在代码中添加一些调试语句,以查看 preguntaRow 的值以及其他相关变量的值。这样可以帮助你确定在哪些情况下出现问题。例如,你可以使用 Debug.Print 语句来输出变量的值,以便在调试时查看:

Debug.Print "preguntaRow: " & preguntaRow

通过这种方式,你可以在运行代码时监视变量的值,以找出为什么有时会出现错误 1004 的原因。可能需要检查你的随机数生成逻辑或其他可能影响 preguntaRow 值的部分。

英文:

Hi I have the next code in VBA:

Sub EscribirPregunta()
    Dim preguntas As Range
    Dim pregunta As Range
    Dim boton As Button
    Dim preguntaSeleccionada As String
    Dim celdasLista As Range
    Dim celda As Range
    Dim ws As Worksheet
    
    ' Establecer el rango de las preguntas
    Set ws = ActiveSheet
    Set preguntas = ws.Range("C2:C23")
    
    ' Verificar si todas las celdas en B2:B23 contienen "1"
    Dim celdasB As Range
    Set celdasB = ws.Range("B2:B23")
    
    If Application.WorksheetFunction.CountIf(celdasB, 1) = celdasB.Count Then
        
        ' Borrar los "1" de la columna B
        celdasB.Value = ""
        
        Exit Sub
    End If
    
    ' Obtener el botón que activó la macro
    Set boton = ActiveSheet.Buttons(Application.Caller)
    
    ' Verificar si ya hay una pregunta en la celda destino
    If boton.TopLeftCell.Value <> "" Then
        Exit Sub ' Salir de la macro si ya hay una pregunta en la celda destino
    End If
    
    ' Crear un rango de las celdas de la lista (L2:L16) sin incluir la celda actual
    Set celdasLista = ws.Range("L2:L16")
    
    ' Filtrar las preguntas que no tienen un "1" en la columna B
    Dim preguntasFiltradas As String
    Dim preguntaRow As Integer
    
    preguntasFiltradas = ""
    preguntaRow = 0
    
    For i = 1 To preguntas.Count
        ' Seleccionar una pregunta aleatoria sin repetición de las preguntas filtradas
        Set pregunta = preguntas.Cells(Application.WorksheetFunction.RandBetween(1, preguntas.Count))
        
        'Comprobar que esa pregunta se haya utizado o no (visualizando si la columna B tiene 1)
        If ws.Cells(pregunta.Row, "B") <> 1 Then 'Si no se ha utilizado aun
            preguntaSeleccionada = pregunta.Value
            preguntaRow = pregunta.Row
            Exit For
        Else 'Si se ha utilizado
            preguntaSeleccionada = ""
            preguntaRow = 0
        End If
        
    Next
    
    ' Mostrar la pregunta seleccionada en la celda del botón
    ws.Cells(boton.TopLeftCell.Row, "L").Value = preguntaSeleccionada
    
    ' Obtener la celda correspondiente en la columna B
    Set celdaB = ws.Cells(preguntaRow, "B")
    
    ' Escribir "1" en la celda correspondiente en la columna B
    celdaB.Value = 1
End Sub

And in Set celdaB = ws.Cells(preguntaRow, "B") sometimes it give me error 1004. Why?

I try everything I know and I expected the reason why it work sometimes and sometimes no.

答案1

得分: 1

以下是另一种执行此操作的方式:

Function EscribirPregunta()
    
    Dim celdasB As Range, rando As Long, f, ws As Worksheet, boton As Button
    Dim tlc As Range
    
    Set ws = ActiveSheet
    
    Set tlc = ws.Buttons(Application.Caller).TopLeftCell
    If Len(tlc.Value) > 0 Then Exit Function
    
    Set celdasB = ws.Range("B2:B23") '包含“已使用”标志的范围
    
    rando = Application.RandBetween(1, celdasB.Cells.Count)
    
    '在单元格# `rando`之后查找第一个空单元格
    '(Find函数在最后一个单元格之后会循环)
    Set f = celdasB.Find("", after:=celdasB.Cells(rando), lookat:=xlWhole, LookIn:=xlValues)
    If Not f Is Nothing Then
        '使用列C中的问题
        tlc.EntireRow.Columns("L").Value = f.Offset(0, 1).Value
        f.Value = 1                       '标记为已使用
    Else
        celdasB.ClearContents             '所有问题都已使用:重置
    End If
    
End Function
英文:

Here is another way of doing it:

Function EscribirPregunta()
    
    Dim celdasB As Range, rando As Long, f, ws As Worksheet, boton As Button
    Dim tlc As Range
    
    Set ws = ActiveSheet
    
    Set tlc = ws.Buttons(Application.Caller).TopLeftCell
    If Len(tlc.Value) > 0 Then Exit Function
    
    Set celdasB = ws.Range("B2:B23") 'range with "used" flag
    
    rando = Application.RandBetween(1, celdasB.Cells.Count)
    
    'find the first empty cell after cell # `rando`
    '   (Find always loops around after the last cell)
    Set f = celdasB.Find("", after:=celdasB.Cells(rando), lookat:=xlWhole, LookIn:=xlValues)
    If Not f Is Nothing Then
        'use the question from Col C
        tlc.EntireRow.Columns("L").Value = f.Offset(0, 1).Value
        f.Value = 1                       'flag as used
    Else
        celdasB.ClearContents             'all questions are used: reset
    End If
    
End Function

huangapple
  • 本文由 发表于 2023年7月18日 04:58:25
  • 转载请务必保留本文链接:https://go.coder-hub.com/76708025.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定