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

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

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

问题

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

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

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

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

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

  1. Debug.Print "preguntaRow: " & preguntaRow

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

英文:

Hi I have the next code in VBA:

  1. Sub EscribirPregunta()
  2. Dim preguntas As Range
  3. Dim pregunta As Range
  4. Dim boton As Button
  5. Dim preguntaSeleccionada As String
  6. Dim celdasLista As Range
  7. Dim celda As Range
  8. Dim ws As Worksheet
  9. ' Establecer el rango de las preguntas
  10. Set ws = ActiveSheet
  11. Set preguntas = ws.Range("C2:C23")
  12. ' Verificar si todas las celdas en B2:B23 contienen "1"
  13. Dim celdasB As Range
  14. Set celdasB = ws.Range("B2:B23")
  15. If Application.WorksheetFunction.CountIf(celdasB, 1) = celdasB.Count Then
  16. ' Borrar los "1" de la columna B
  17. celdasB.Value = ""
  18. Exit Sub
  19. End If
  20. ' Obtener el botón que activó la macro
  21. Set boton = ActiveSheet.Buttons(Application.Caller)
  22. ' Verificar si ya hay una pregunta en la celda destino
  23. If boton.TopLeftCell.Value <> "" Then
  24. Exit Sub ' Salir de la macro si ya hay una pregunta en la celda destino
  25. End If
  26. ' Crear un rango de las celdas de la lista (L2:L16) sin incluir la celda actual
  27. Set celdasLista = ws.Range("L2:L16")
  28. ' Filtrar las preguntas que no tienen un "1" en la columna B
  29. Dim preguntasFiltradas As String
  30. Dim preguntaRow As Integer
  31. preguntasFiltradas = ""
  32. preguntaRow = 0
  33. For i = 1 To preguntas.Count
  34. ' Seleccionar una pregunta aleatoria sin repetición de las preguntas filtradas
  35. Set pregunta = preguntas.Cells(Application.WorksheetFunction.RandBetween(1, preguntas.Count))
  36. 'Comprobar que esa pregunta se haya utizado o no (visualizando si la columna B tiene 1)
  37. If ws.Cells(pregunta.Row, "B") <> 1 Then 'Si no se ha utilizado aun
  38. preguntaSeleccionada = pregunta.Value
  39. preguntaRow = pregunta.Row
  40. Exit For
  41. Else 'Si se ha utilizado
  42. preguntaSeleccionada = ""
  43. preguntaRow = 0
  44. End If
  45. Next
  46. ' Mostrar la pregunta seleccionada en la celda del botón
  47. ws.Cells(boton.TopLeftCell.Row, "L").Value = preguntaSeleccionada
  48. ' Obtener la celda correspondiente en la columna B
  49. Set celdaB = ws.Cells(preguntaRow, "B")
  50. ' Escribir "1" en la celda correspondiente en la columna B
  51. celdaB.Value = 1
  52. 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

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

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

Here is another way of doing it:

  1. Function EscribirPregunta()
  2. Dim celdasB As Range, rando As Long, f, ws As Worksheet, boton As Button
  3. Dim tlc As Range
  4. Set ws = ActiveSheet
  5. Set tlc = ws.Buttons(Application.Caller).TopLeftCell
  6. If Len(tlc.Value) > 0 Then Exit Function
  7. Set celdasB = ws.Range("B2:B23") 'range with "used" flag
  8. rando = Application.RandBetween(1, celdasB.Cells.Count)
  9. 'find the first empty cell after cell # `rando`
  10. ' (Find always loops around after the last cell)
  11. Set f = celdasB.Find("", after:=celdasB.Cells(rando), lookat:=xlWhole, LookIn:=xlValues)
  12. If Not f Is Nothing Then
  13. 'use the question from Col C
  14. tlc.EntireRow.Columns("L").Value = f.Offset(0, 1).Value
  15. f.Value = 1 'flag as used
  16. Else
  17. celdasB.ClearContents 'all questions are used: reset
  18. End If
  19. 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:

确定